Dzwebs.Net

　　问题需求：如何将同一文件夹中的多个记事本文本文件读入到工作簿中？

　　问题分析：通常，我们所看到的例子都是在工作簿中读入一个文本文件中的内容。假设有几个文本文件，我们把它们放在与工作簿相同的文件夹中，那么，如何在该工作簿中一次性读取这几个文本文件的内容。

　　问题的解决办法：

　　下面的VBA程序代码可帮助您解决此类问题。

　　分两种情况：

　　①所读入的文本文件总行数小于65536行，您可以使用以下代码。

Sub Sample1()
    Dim n As Long, a(), ff As Integer, txt As String, myDir As String, x
    Dim myF As String, i As Long
    myDir = ThisWorkbook.Path & Application.PathSeparator
    myF = Dir(myDir & "*.txt")
    Do While myF <> ""
        ff = FreeFile
        Open myDir & myF For Input As #ff
        Do While Not EOF(ff)
            Line Input #ff, txt
            x = Split(txt, "|")
            n = n + 1
            ReDim Preserve a(1 To n)
            a(n) = x
        Loop
        Close #ff
        myF = Dir()
    Loop
    Cells.Clear
    With ThisWorkbook.Worksheets("Sheet1").Range("a1")
        For i = 1 To UBound(a)
            .Offset(i - 1).Resize(, UBound(a(i)) + 1) = a(i)
        Next
    End With
End Sub

　　②所读入的文本文件总行数大于65536行，您可以使用以下代码。其中使用了一个变量t和一个判断语句，当多于65536行时，将剩下的数据写入另一工作表中。

Sub Sample2()
    Dim n As Long, a(), ff As Integer, txt As String, myDir As String, x
    Dim myF As String, i As Long, t As Integer
    t = 1
    myDir = ThisWorkbook.Path & Application.PathSeparator
    myF = Dir(myDir & "*.txt")
    Do While myF <> ""
        ff = FreeFile
        Open myDir & myF For Input As #ff
        Do While Not EOF(ff)
            Line Input #ff, txt
            x = Split(txt, "|")
            n = n + 1
            ReDim Preserve a(1 To n)
            a(n) = x
            If n = 65536 Then
                With ThisWorkbook.Sheets(t).Range("a1")
                    For i = 1 To UBound(a)
                        .Offset(i - 1).Resize(, UBound(a(i)) + 1) = a(i)
                    Next
                End With
                n = 0: Erase a: t = t + 1
            End If
        Loop
            Close #ff
            myF = Dir()
    Loop
        If n > 0 Then
            With ThisWorkbook.Sheets(t).Range("a1")
                For i = 1 To UBound(a)
                    .Offset(i - 1).Resize(, UBound(a(i)) + 1) = a(i)
                Next
            End With
        End If
End Sub

　　代码的使用方法：打开"您的Excel文件.XLS"，按[ALT+F8]键，执行宏“Yjue”……

   myPath = ThisWorkbook.Path & "\2009年9月\"
   myFile = Dir(myPath & "*.xls")
   Do While myFile <> ""    ' 开始循环。
      If myFile <> "2003年6月.XLS" Then
         Workbooks.Open myPath & "\" & myFile, 0
         ThisWorkbook.Activate
         Workbooks(myFile).Sheets("生产数据").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
         myName = Format(Left(Right(Split(myFile, ".")(0), 2), 1), "00")
         Workbooks(myFile).Close False
         ThisWorkbook.Sheets(Sheets.Count).Name = myName
      End If
      myFile = Dir    ' 查找下一个目录。
   Loop