问题
I have a daily dump of 2 different text files (in the same folder) that get overwritten daily. I would like to be able to import them into an active spreadsheet with tab delimited, at the same time with a VBA code. I would really appreciate the help!
I am using excel 2016. My manual import method of 1 of the text file when recorded gives this code which is how i would like BOTH the text files to be imported (formatting preserved):
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Mr D\Music\New folder\B.txt", Destination:=Range("$A$1"))
.CommandType = 0
.Name = "B"
.FieldNames = True
.RowNumbers =enter code here False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
The code that i have tried using is from other similar questions posted here does not seem to work:
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("C:\Users\Mr D\Music\")
' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)
' Loop thru all files in the folder
For Each file In folder.Files
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine
' Parse the line into | delimited pieces
Items = Split(TextLine, "|")
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
' Move to next row
Set cl = cl.Offset(1, 0)
Loop
' Clean up
FileText.Close
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
回答1:
do like this if your text files is with tab delimited.
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
Dim sFolder As String, vDB, Ws As Worksheet
Dim rngT As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
sFolder = "C:\Users\Mr D\Music\"
Set folder = fso.GetFolder(sFolder)
' set the starting point to write the data to
Set Ws = ActiveSheet
'Set cl = ActiveSheet.Cells(1, 1)
' Loop thru all files in the folder
For Each file In folder.Files
Workbooks.Open Filename:=sFolder & file.Name, Format:=1
With ActiveWorkbook.ActiveSheet
vDB = .UsedRange
End With
ActiveWorkbook.Close
Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2)
rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
Next file
Ws.Range("a1").EntireRow.Delete
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
From the second text file, the header will be ignored.
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
Dim sFolder As String, vDB, Ws As Worksheet
Dim rngT As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
sFolder = "C:\Users\Mr D\Music\"
Set folder = fso.GetFolder(sFolder)
' set the starting point to write the data to
Set Ws = ActiveSheet
'Set cl = ActiveSheet.Cells(1, 1)
Ws.Cells.Clear
' Loop thru all files in the folder
For Each file In folder.Files
i = i + 1
Workbooks.Open Filename:=sFolder & file.Name, Format:=1
With ActiveWorkbook.ActiveSheet
If i = 1 Then
vDB = .UsedRange
Else
vDB = .UsedRange.Offset(1)
End If
End With
ActiveWorkbook.Close
Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2)
rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
Next file
Ws.Range("a1").EntireRow.Delete
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
来源:https://stackoverflow.com/questions/48134634/importing-multiple-text-files-using-vba-macro