读取文件夹中的所有文件并在Excel中显示内容

Dro*_*zzy -1 excel vba excel-vba

我想显示文件夹和excel中的7000个文件内容?

我找到了一段代码,它帮助了我,但它是唯一一本一读.但是,我想一次性阅读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
Run Code Online (Sandbox Code Playgroud)

Sid*_*out 6

user1185158

当您阅读7000个文件时,您使用的代码将非常慢.此外,没有代码可以一次读取7000个文件.您将不得不遍历7000个文件.然而,有一个好消息:)您可以将整个文件读入数组,然后将其写入excel,而不是循环遍历文本文件中的每一行.例如,与上面的代码相比,请查看此代码的速度非常快.

经过试验和测试

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
Run Code Online (Sandbox Code Playgroud)

现在在循环中使用相同的代码,我们可以将其写入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
Run Code Online (Sandbox Code Playgroud)

上面的代码所做的是它读取了表1中的7000个文本文件的内容(一个在另一个之下).此外,我还没有包括错误处理.请这样做.

注意:如果您正在阅读繁重的文本文件,例如,每个文件有10000行,那么您将不得不调整上述方案中的代码,因为您将收到错误.例如

7000个文件*10000行= 70000000行

Excel 2003有65536行,Excel 2007/2010有1048576行.

因此,一旦WriteRow达到最大行,您可能希望将文本文件内容读入Sheet 2,依此类推......

HTH

希德