Search code examples
vbaexcelopenfiledialogworksheet

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


I have a code that allows me to open multiple files in an excel workbook, however instead of having to manually select the dat files I want to open I want to be able to loop my code so that it goes through all my files and searches for the dat files called p00001, p00002, p00003 and so on. Does anyone know how I can edit my code to select all the files called this?

My code is:

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

Solution

  • You need to do a Folder drill down. You can see a sample below. All you need to do is to adjust this if Statment If InStr(File, ".dat") And InStr(File, "\p0") Then so only the Files you want to have are 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