vba 读取文件夹中的所有文件并在 Excel 中显示内容
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/9509091/
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
Reading all files in Folder and showing content in Excel
提问by Drozzy
I want to show 7000 files content that are in a folder and in excel?
我想显示文件夹和 Excel 中的 7000 个文件内容？
I have a found a piece of code that helped me but its only reading one by one. However, I want to read 7000 all in one go. Please help.
我找到了一段对我有帮助的代码，但它只能一个一个地阅读。但是，我想一口气读完7000篇。请帮忙。
Option Explicit
Sub Import_TXT_File()
Dim strg As Variant
Dim EntireLine As String
Dim FName As String
Dim i As String
Application.ScreenUpdating = False
FName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Choose File to Import")
Open FName For Input Access Read As #1
i = 1
While Not EOF(1)
Line Input #1, EntireLine
strg = EntireLine
'Change "Sheet1" to relevant Sheet Name
'Change "A" to the relevant Column Name
Sheets("Sheet1").Range("A" & i).Value = strg
i = i + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub
回答by Siddharth Rout
user1185158
用户1185158
The code which you are using will be very slow when you are reading 7000 files. Also there is no code which can read 7000 files in 1 go. You will have to loop through the 7000 files. However there is one good news :) Instead of looping through every line in the text file, you can read the entire file into an array and then write it to excel. For example see this code which is very fast as compared to the code that you have above.
当您读取 7000 个文件时，您使用的代码会非常慢。也没有可以一次读取 7000 个文件的代码。您将不得不遍历 7000 个文件。然而，有一个好消息 :) 您可以将整个文件读入一个数组，然后将其写入 excel，而不是遍历文本文件中的每一行。例如，查看此代码与您上面的代码相比非常快。
TRIED AND TESTED
久经考验
Sub Sample()
Dim MyData As String, strData() As String
Open "C:\MyFile.Txt" For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
End Sub
Now using the same code in a loop we can write it into an Excel File
现在在循环中使用相同的代码，我们可以将其写入 Excel 文件
'~~> Change this to the relevant path
Const strPath As String = "C:\Temp\"
Sub Sample()
Dim ws As Worksheet
Dim MyData As String, strData() As String
Dim WriteToRow As Long, i As Long
Dim strCurrentTxtFile As String
Set ws = Sheets("Sheet1")
'~~> Start from Row 1
WriteToRow = 1
strCurrentTxtFile = Dir(strPath & "*.Txt")
'~~> Looping through all text files in a folder
Do While strCurrentTxtFile <> ""
'~~> Open the file in 1 go to read it into an array
Open strPath & strCurrentTxtFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
'~~> Read from the array and write to Excel
For i = LBound(strData) To UBound(strData)
ws.Range("A" & WriteToRow).Value = strData(i)
WriteToRow = WriteToRow + 1
Next i
strCurrentTxtFile = Dir
Loop
MsgBox "Done"
End Sub
What the above code does is that it reads the contents of the 7000 text files in sheet 1 (one below the other). Also I have not included error handling. Please do that.
上面代码的作用是读取工作表 1 中 7000 个文本文件的内容（一个在另一个之下）。我也没有包括错误处理。请这样做。
CAUTION: If you are reading heavy text files, say, each file has 10000 lines then you will have to tweak the code in the above scenario as you will get errors. for example
注意：如果您正在阅读大量文本文件，例如，每个文件有 10000 行，那么您将不得不在上述场景中调整代码，因为您会收到错误消息。例如
7000 Files * 10000 lines = 70000000 lines
7000 个文件 * 10000 行 = 70000000 行
Excel 2003 has 65536 rows and Excel 2007/2010 has 1048576 rows.
Excel 2003 有 65536 行，Excel 2007/2010 有 1048576 行。
So once the WriteRowreaches the maximum row, you might want to read the text file contents into Sheet 2 and so on...
因此，一旦WriteRow达到最大行，您可能希望将文本文件内容读入工作表 2，依此类推...
HTH
HTH
Sid
锡德
回答by SWa
Taking Siddharth's solution a little further. You probably don't want to write each row one at a time, calls to the worksheet are extremely slow in Excel, it is better to do any looping in memory and write back in one fell swoop :)
将悉达多的解决方案更进一步。您可能不想一次写入每一行，在 Excel 中调用工作表非常慢，最好在内存中进行任何循环并一举写回:)
Sub Sample()
Dim ws As Worksheet
Dim MyData As String, strData() As String, strData2() As String
Dim WriteToRow As Long, i As Long
Dim strCurrentTxtFile As String
Set ws = Sheets("Sheet1")
'~~> Start from Row 1
WriteToRow = 1
strCurrentTxtFile = Dir(strPath & "*.Txt")
'~~> Looping through all text files in a folder
Do While strCurrentTxtFile <> ""
'~~> Open the file in 1 go to read it into an array
Open strPath & strCurrentTxtFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData = Split(MyData, vbCrLf)
'Resize and transpose 1d array to 2d
ReDim strData2(1 To UBound(strData) + 1, 1 To 1)
For i = 1 To UBound(strData)
strData2(i, 1) = strData(i - 1)
Next i
Sheet1.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Offset(1).Resize(UBound(strData), 1).Value = strData2
strCurrentTxtFile = Dir
Loop
MsgBox "Done"
End Sub
