打印本文 打印本文 关闭窗口 关闭窗口
excel-vba应用示例之将同一文件夹中的多个文本文件读入到工作簿中
作者:武汉SEO闵涛  文章来源:敏韬学习网  点击数4681  更新时间:2010/6/21 21:55:25  文章录入:mintao  责任编辑:mintao

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

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

  问题的解决办法

  下面的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

打印本文 打印本文 关闭窗口 关闭窗口