I need to import multiple text files into 1 excel worksheet. I tried the code below but it does only part of the job I need. All text files are in the same folder, and have the same name. Therefore, they are: test (1), test (2),..etc.
The goals are: import all the text files in only 1 excel worksheet; the text files should be paste horizontally: 1 row for each text file in excel. Then, the content of the files should be paste in text format. Could you help me in solving this problem?
Sub Files()
Dim myfiles
Dim i As Integer
myfiles = Application.GetOpenFilename(filefilter:="TEXT Files (*.txt), *.txt", MultiSelect:=True)
If Not IsEmpty(myfiles) Then
For i = LBound(myfiles) To UBound(myfiles)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myfiles(i), Destination:=range("A" & Rows.Count).End(xlUp).Offset(1, 0))
.Name = "test"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(xlGeneralFormat)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next i
Else
MsgBox "No File Selected"
End If
End Sub
This should do it for you.
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim i As Long
Dim cl As Range
Set fso = New FileSystemObject
Set folder = fso.GetFolder("C:\your_path\")
Set cl = ActiveSheet.Cells(1, 1)
Application.ScreenUpdating = False
For Each file In folder.Files
Set FileText = file.OpenAsTextStream(ForReading)
cl.Value = file.Name
i = 1
Do While Not FileText.AtEndOfStream
cl.Offset(i, 0).Value = FileText.ReadLine
i = i + 1
Loop
FileText.Close
Set cl = cl.Offset(0, 1)
Next file
Application.ScreenUpdating = True
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.