VBAコードを使用してdatファイルを検索し、同じブックの別のシートで開く

Question

Excelファイルのブックを複数開くことができるコードがありますが、手動で目的のファイルを選択する必要はありません私はすべての私のファイルを通過し、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のようにしておきたいファイルだけを残しておきたい場合は、これを調整するだけです。

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