VBA代码以搜索罪名文件并在同一工作簿的单独床单中打开它们

Question

我有一个允许我在Excel Workbook中打开多个文件的代码，但是而不是手动选择要打开的DAT文件，我希望能够循环我的代码这样它遍历了我的所有文件，并搜索称为p00001，p00002，p00003等的dat文件。有人知道如何编辑我的代码以选择所有称为此的文件？

我的代码是：

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

您需要向下进行文件夹钻孔。您可以在下面看到一个示例。如果Statment If InStr(File, ".dat") And InStr(File, "p0") Then，您需要做的就是调整此问题，以便只有您要拥有的文件才是beeing opend。

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