我有一个代码可以将不同的多个 .txt 文件的全部内容放入 Excel 2010，但需要一些更改

Question

有什么方法可以将不同的多个 .txt 文件的全部内容（实际上是一个文件夹中所有 .txt 文件的内容）放入 Excel 2010？我需要一个单元格 (A1) 作为文件名，另一个单元格 (A2) 作为该 .txt 文件的全部内容。其他 .txt 文件也是如此，即 B1-B2、C1-C2 等。

我有这个代码：

Sub test() 
    Dim myDir As String, fn As String, ff As Integer, txt As String 
    Dim delim As String, n As Long, b(), flg As Boolean, x 
    myDir = "c:\test" '<- change to actual folder path
    delim = vbTab '<- delimiter (assuming Tab delimited)
    Redim b(1 To Rows.Count, 1 To 1) 
    fn = Dir(myDir & "\*.txt") 
    Do While fn <> "" 
        ff = FreeFile 
        Open myDir & "\" & fn For Input As #ff 
        Do While Not EOF(ff) 
            Line Input #ff, txt 
            x = Split(txt, delim) 
            If Not flg Then 
                n = n + 1 : b(n,1) = fn 
            End If 
            If UBound(x) > 0 Then 
                n = n + 1 
                b(n,1) = x(1) 
            End If 
            flg = True 
        Loop 
        Close #ff 
        flg = False 
        fn = Dir() 
    Loop 
    ThisWorkbook.Sheets(1).Range("a1").Resize(n).Value = b 
End Sub

但是这段代码的问题是它只导入文件名，而不是内容，我想这是由于上面的代码使用“delim = vbTab”而我没有任何分隔符文件的内容。我希望将一个文件的全部内容导入到一个单元格中。

Answer 1

这与您使用的方法不同，但我是这样做的：

Option Explicit

Sub ImportManyTXTIntoColumns()
'Summary:   From a specific folder, import TXT files 1 file per column
Dim fPath As String, fTXT As String
Dim wsTrgt As Worksheet, NC As Long

Application.ScreenUpdating = False
fPath = "C:\2010\"                      'path to files
Set wsTrgt = ThisWorkbook.Sheets.Add    'new sheet for incoming data
NC = 1                                  'first column for data

fTXT = Dir(fPath & "*.txt")             'get first filename

    Do While Len(fTXT) > 0              'process one at a time
                                        'open the file in Excel
        Workbooks.OpenText fPath & fTXT, Origin:=437
                                        'put the filename in the target column
        wsTrgt.Cells(1, NC) = ActiveSheet.Name
                                        'copy column A to new sheet
        Range("A:A").SpecialCells(xlConstants).Copy wsTrgt.Cells(2, NC)

        ActiveWorkbook.Close False      'close the source file
        NC = NC + 1                     'next column
        fTXT = Dir                      'next file
    Loop

Application.ScreenUpdating = True
End Sub

Answer 2

FileSystemObject（Microsoft 脚本运行时的一部分）提供了一个很好的文件处理替代方案。

这是一个使用此模块的快速大纲。

注意：

1. 它利用早期绑定，因此需要引用脚本运行时。如果您愿意，可以轻松地将其更改为后期绑定。
2. 为了清楚起见，我省略了错误处理和各种速度优化。它是否足够安全或足够快将取决于您的预期用途以及文件的数量和大小。

---

Sub test()
    Dim fso As FileSystemObject
    Dim txt As TextStream
    Dim pth As String
    Dim fl As File
    Dim str As String
    Dim cl As Range

    Set fso = New FileSystemObject
    pth = "C:\Test"
    Set cl = [A1]
    For Each fl In fso.GetFolder(pth).Files
        If StrComp(Right(fl.Name, 4), ".txt", vbTextCompare) = 0 Then
            Set txt = fso.OpenTextFile(fl.Path, ForReading)
            cl = fl.Name
            str = txt.ReadAll

            ' option: use this loop to split long files into multiple cells
            Do While Len(str) > 32767
                cl.Offset(0, 1) = Left(str, 32767)
                Set cl = cl.Offset(0, 1)
                str = Mid(str, 32768)
            Loop

            cl.Offset(0, 1) = str
            Set cl = cl.EntireRow.Cells(2, 1)
            txt.Close
        End If
    Next

    Set txt = Nothing
    Set fso = Nothing
End Sub