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

Question

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

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

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

我发现您可以在单元格中使用一个公式，该公式将从已关闭的工作簿中提取数据。如果您在单元格中键入 ='folderpath[filename]Sheetname'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 文件以提取数据

Read closed .xlsm files as xml files to pull data

vba

excel

xlsm