Vba 搜索有罪的 dat 文件并在同一工作簿的不同工作表中打开它们的代码

Question

我有一个代码可以让我在 excel 工作簿中打开多个文件，但是不必手动 select 我想打开的 dat 文件我希望能够循环我的代码，以便它遍历我的所有文件并搜索名为 p00001、p00002、p00003 等的 dat 文件。有谁知道如何将我的代码编辑为 select 所有调用此文件的文件？

我的代码是：

Sub ImportFiles()
    Dim sheet As Worksheet
    Dim total As Integer
    Dim intChoice As Integer
    Dim strPath As String
    Dim i As Integer
    Dim wbNew As Workbook
    Dim wbSource As Workbook
    Set wbNew = Workbooks.Add


    'allow the user to select multiple files
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
    'make the file dialog visible to the user
    intChoice = Application.FileDialog(msoFileDialogOpen).Show

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'determine what choice the user made
    If intChoice <> 0 Then
        'get the file path selected by the user
        For i = 1 To Application.FileDialog(msoFileDialogOpen).SelectedItems.Count
            strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(i)

            Set wbSource = Workbooks.Open(strPath)

            For Each sheet In wbSource.Worksheets
                total = wbNew.Worksheets.Count
                wbSource.Worksheets(sheet.Name).Copy _
                after:=wbNew.Worksheets(total)
            Next sheet

            wbSource.Close
        Next i
    End If

End Sub

Answer 1

您需要向下钻取文件夹。您可以在下面看到一个示例。所有你需要做的就是调整这个 if Statment If InStr(File, ".dat") And InStr(File, "\p0") Then 所以只有你想要的文件被打开。

Public sheet As Worksheet
    Public total As Integer
    Public intChoice As Integer
    Public strPath As String
    Public i As Integer
    Public wbNew As Workbook
    Public wbSource As Workbook


Sub main()
Set wbNew = Workbooks.Add
        Dim FileSystem As Object
        Dim HostFolder As String

        HostFolder = "D:\test"

        Set FileSystem = CreateObject("Scripting.FileSystemObject")
        DoFolder FileSystem.GetFolder(HostFolder)
    End Sub

Sub DoFolder(Folder)
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    Dim File
    For Each File In Folder.Files
        If InStr(File, ".dat") And InStr(File, "\p0") Then

            strPath = File
            Set wbSource = Workbooks.Open(strPath)
            For Each sheet In wbSource.Worksheets
                total = wbNew.Worksheets.Count
                wbSource.Worksheets(sheet.Name).Copy _
                after:=wbNew.Worksheets(total)
            Next sheet
            wbSource.Close
        End If
    Next
End Sub

Vba 搜索有罪的 dat 文件并在同一工作簿的不同工作表中打开它们的代码

Vba code to search for incriminating dat files and open them in separate sheets of the same workbook

excel

vba

openfiledialog

worksheet