excel vba - 将 .txt（制表符分隔）文件的文件夹导入下一个可用行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15299254/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
excel vba - import folder of .txt (tab delimted) files into next available row
提问by Mic Burns
I've been racking my brains trying to create a macro in excel which opens all .txt files in a specific folder and imports them into the next available row. The data is tab delimited, and the first file needs to be imported into cell B8, the next file B9, the next B10, etc.
我一直在绞尽脑汁试图在 excel 中创建一个宏，它会打开特定文件夹中的所有 .txt 文件并将它们导入下一个可用行。数据以制表符分隔，第一个文件需要导入到单元格B8，下一个文件B9，下一个B10等。
I'm about 80% there with this code, but it's importing all data into one cell (B8), rather than tab delimited into rows (B8, C8, D8, E8, etc).
我大约有 80% 使用此代码，但它将所有数据导入一个单元格 (B8)，而不是将制表符分隔成行（B8、C8、D8、E8 等）。
Sub Read_Text_Files()
Dim sPath As String, sLine As String
Dim oPath As Object, oFile As Object, oFSO As Object
Dim r As Long
'
'Files location
sPath = "C:\Test\"
'Text to Columns
Range("A1", Range("A" & Cells.Rows.Count).End(xlUp)).Select
Selection.TextToColumns DataType:=TabDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False
Application.ScreenUpdating = True
r = 8
Set oFSO = CreateObject( _
"Scripting.FileSystemObject")
Set oPath = oFSO.GetFolder(sPath)
Application.ScreenUpdating = False
For Each oFile In oPath.Files
If LCase(Right(oFile.Name, 4)) = ".txt" Then
Open oFile For Input As #1
Do While Not EOF(1) ' Loop until end of file.
Input #1, sLine ' Read data
Range("B" & r).Formula = sLine ' Write data line
r = r + 1
Loop
Close #1 ' Close file.
'
End If
Next oFile
End Sub
采纳答案by Ross McConeghy
I suggest continuing as you mentioned in your comment, use Workbooks.OpenText to open each file and then copy each row from the opened workbook to the specified sheet.
我建议您继续在评论中提到，使用 Workbooks.OpenText 打开每个文件，然后将打开的工作簿中的每一行复制到指定的工作表。
Sub Read_Text_Files()
Dim sPath As String
Dim oPath, oFile, oFSO As Object
Dim r, iRow As Long
Dim wbImportFile As Workbook
Dim wsDestination As Worksheet
'Files location
sPath = "C:\Test\"
Set wsDestination = ThisWorkbook.Sheets("Sheet1")
r = 8
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oPath = oFSO.GetFolder(sPath)
Application.ScreenUpdating = False
For Each oFile In oPath.Files
If LCase(Right(oFile.Name, 4)) = ".txt" Then
'open file to impor
Workbooks.OpenText Filename:=oFile.Path, Origin:=65001, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Set wbImportFile = ActiveWorkbook
For iRow = 1 To wbImportFile.Sheets(1).UsedRange.Rows.Count
wbImportFile.Sheets(1).Rows(iRow).Copy wsDestination.Rows(r)
r = r + 1
Next iRow
wbImportFile.Close False
Set wbImportFile = Nothing
End If
Next oFile
End Sub
