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 Scripting Runtime的一部分）提供了一个很好的文件处理替代方案。

以下是使用此模块的快速概述。

注意：

它利用早期绑定，因此需要引用Scripting Runtime。如果您愿意，可以很容易地改为后期绑定。
为了清楚起见，我省略了错误处理和各种速度优化。它是否足够安全或足够快将取决于您的预期用途以及文件的数量和大小。

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

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

2 个答案: