【问题标题】:Reading data from text file vba从文本文件 vba 中读取数据
【发布时间】:2013-09-09 19:47:56
【问题描述】:

我有几个子文件夹。每个都有文本文件。可以将文本文件分组到一个 excel 文件中,这样每个 excel 选项卡就有一个文件。我设计了代码来完成这项任务。

Option Explicit
Sub read_files()
Dim ReadData As String
Dim i As Double
Dim objfso As Object
Dim objfolder As Object
Dim obj_sub_folder As Object
Dim objfile As Object
Dim current_worksheet As Worksheet
Dim new_workbook As Workbook
Dim path As String
Dim filestream As Integer


Set objfso = CreateObject("Scripting.FilesystemObject")
Set objfolder = objfso.getfolder("Z:\test\")
Set new_workbook = Workbooks.Add
i = 1

For Each obj_sub_folder In objfolder.subfolders
    i = 1
    ReadData = ""
    For Each objfile In obj_sub_folder.Files
        Set current_worksheet = new_workbook.Worksheets.Add
        current_worksheet.Name = objfile.Name
        filestream = FreeFile()
        path = "Z:\test\" & obj_sub_folder.Name & "\" & objfile.Name
        Open path For Input As #filestream
        Do Until EOF(filestream)
            Input #filestream, ReadData
            current_worksheet.Cells(i, 1).Value = ReadData
            i = i + 1
        Loop
        Close filestream
    Next
    ActiveWorkbook.SaveAs "Z:\test\" & obj_sub_folder.Name
Next End Sub

但是,在遍历子文件夹时,宏会保存先前子文件夹中文件的数据,但我想保存来自特定子文件夹的文件中的数据。你能解释一下我的错误在哪里吗?

谢谢!

编辑

这是工作代码

Option Explicit
Sub run()
     read_files ("Z:\test\")
End Sub
Sub read_files(path_to_folder As String)
Dim ReadData As String
Dim i As Double
Dim objfso As Object
Dim objfolder As Object
Dim obj_sub_folder As Object
Dim objfile As Object
Dim current_worksheet As Worksheet
Dim new_workbook As Workbook
Dim path As String
Dim filestream As Integer

Set objfso = CreateObject("Scripting.FilesystemObject")
Set objfolder = objfso.getfolder(path_to_folder)
i = 1

For Each obj_sub_folder In objfolder.subfolders
    Set new_workbook = Workbooks.Add

    For Each objfile In obj_sub_folder.Files
        Set current_worksheet = new_workbook.Worksheets.Add
        current_worksheet.Name = objfile.Name
        filestream = FreeFile()
        path = path_to_folder & obj_sub_folder.Name & "\" & objfile.Name
        Open path For Input As #filestream
        Do Until EOF(filestream)
            Input #filestream, ReadData
            current_worksheet.Cells(i, 1).Value = ReadData
            i = i + 1
        Loop
        Close filestream
        i = 1
    Next
    ActiveWorkbook.SaveAs path & obj_sub_folder.Name
    ActiveWorkbook.Close
Next

结束子

【问题讨论】:

  • 如果您使用导入规范打开文件,然后将数据复制/粘贴到新工作表中,您应该绕过文件创建问题。
  • @AlanWaage,但如果我确实喜欢你的建议,那么我必须创建导入文件。
  • 仅在内存中,如果不保存导入,则不会创建文件。您所做的只是在将数据复制到所需位置后强制关闭而不保存新的 Excel 对象。
  • 查看this walkthrough了解如何在vba中读取txt文件

标签: vba excel


【解决方案1】:

如果您希望每个子文件夹的数据位于单独的工作簿中,则需要将您的 new_workbook 定义移动到您的 For Each obj_sub_folder 循环中,并在保存后关闭该工作簿:

Set objfso = CreateObject("Scripting.FilesystemObject")
Set objfolder = objfso.getfolder("Z:\test\")
i = 1

For Each obj_sub_folder In objfolder.subfolders
    Set new_workbook = Workbooks.Add
    i = 1
    ReadData = ""
    For Each objfile In obj_sub_folder.Files
        Set current_worksheet = new_workbook.Worksheets.Add
        current_worksheet.Name = objfile.Name
        filestream = FreeFile()
        path = "Z:\test\" & obj_sub_folder.Name & "\" & objfile.Name
        Open path For Input As #filestream
        Do Until EOF(filestream)
            Input #filestream, ReadData
            current_worksheet.Cells(i, 1).Value = ReadData
            i = i + 1
        Loop
        Close filestream
    Next
    new_workbook.SaveAs "Z:\test\" & obj_sub_folder.Name
    new_workbook.Close
Next 

【讨论】:

  • 您能建议如何提高 IO 性能吗?处理一个非常慢的文件需要 4 分钟。我试图创建 2d arrat,但仍然 - 还剩 4 分钟......
  • @mr.M 请参阅here 了解各种导入文本文件的方法——要避免的主要事情是必须为每一行执行一个操作。
猜你喜欢
  • 1970-01-01
  • 2021-06-12
  • 2011-02-08
  • 1970-01-01
  • 2012-06-10
  • 2020-05-26
  • 2023-03-06
  • 2015-08-11
  • 1970-01-01
相关资源
最近更新 更多