Question

我是一名新程序员，我正在尝试从多个工作簿中提取一系列数据并将其复制到主文件中。我已经在下面编写了代码来执行此操作，但我遇到的问题是我的代码在物理上打开了xlsm文件＆gt;复制数据＆gt;然后返回主文件进行粘贴。由于这是一次完成数千个文件，因此需要数小时才能完成。我的老板告诉我有一种方法可以从xlsm文件中复制数据，而不会让代码实际打开文件，如果它被读取为xml或.txt文件。我在网上搜索过这个，但找不到任何关于如何做到的事情。任何帮助将不胜感激。

我实际打开工作簿的代码：

Option Explicit

Sub ReadDataFromCloseFile()
    On Error GoTo ErrHandler

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Dim FileType As String
    Dim FilePath As String

    FileType = "*.xlsm*" 'The file type to search for
    FilePath = "C:\Users\hasib\xlsm's\" 'The folder to search

    Dim src As Workbook
    Dim OutputCol As Variant
    Dim Curr_File As Variant

    OutputCol = 9 'The first row of the active sheet to start writing to

    Curr_File = Dir(FilePath & FileType)

    Do Until Curr_File = ""
        ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
        Set src = Workbooks.Open(FilePath & Curr_File, True, True)

        Sheets("Reporting").Range("I7:I750").Copy

        Workbooks("Master.xlsm").Activate
        Sheets("Sheet2").Select
        Sheets("Sheet2").Cells(4, OutputCol).Select
        ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
        OutputCol = OutputCol + 1

        ' CLOSE THE SOURCE FILE.
        src.Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
        Curr_File = Dir
    Loop
    Set src = Nothing


    Application.EnableEvents = True
    Application.ScreenUpdating = True

ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Answer 1

我发现有一个公式可以在一个单元格中使用，它将从已关闭的工作簿中提取数据。如果您键入=＆＃39; folderpath [filename] Sheetname＆＃39; Cell进入单元格，它将自动输入该信息。使用这个逻辑，我创建了以下内容来遍历我的所有文件，并将数据从被调用的文件粘贴到我的工作簿中：

Set fd = Application.FileDialog(msoFileDialogFilePicker)

fd.InitialFileName = "c:\"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True

FileChosen = fd.Show

FilePath = fd.SelectedItems(1)
FolderPath = Left(FilePath, InStrRev(FilePath, "\"))

If FileChosen = -1 Then
'open each of the files chosen
For c = 1 To fd.SelectedItems.count
FileName = Dir(fd.SelectedItems(c))

ThisWorkbook.Sheets("Batch Results").Cells(OutputRow, OutputCol).Formula = "='" & FolderPath & "[" & FileName & "]Reporting'!$I7"
OutputCol = OutputCol + 1
Next c
End If

ThisWorkbook.Sheets("Batch Results").Select
Cells(1, OutputCol).Select
EndColumn = Split(ActiveCell(1).Address(1, 0), "$")(0)
RangeName = ("A1:" & EndColumn & "1")
Range(RangeName).Select
Selection.AutoFill Destination:=Range("A1:" & EndColumn & "558"), Type:=xlFillDefualt

将封闭的.xlsm文件作为xml文件读取以提取数据

1 个答案: