Macro to open several Files

[howard]

I have a macro to open a workbook using a wilcard Character


I would like the code amended to open 3 workbooks starting with

The workbooks to be opened are all .xlsm workbooks

Bauten East
Prolen South
Prolem North


Eg Bauten East Sales Oct 2022.xlsm


I need a wildcard Character so to limit the files to be selected in "C:\Sales Reports by month"


Your assistance is most appreciated

 Sub Open_Workbook()

Dim xfile As Variant

Dim wb2 As Workbook


Application.ScreenUpdating = False



ChDir ("C:\Sales Reports by month")

With Application.FileDialog(msoFileDialogFilePicker)

.ButtonName = "Open"

.Filters.Clear

.Filters.Add "Excel Files", "*.xlsm"

.InitialFileName = "*Bauten East*.xlsm"

.Title = "Select File"

If .Show <> -1 Then Exit Sub

For Each xfile In .SelectedItems

Set wb2 = Workbooks.Open(xfile)

wb2.Sheets(2).UsedRange.Copy _

ThisWorkbook.Sheets("Imported Data").Range("A" & Rows.Count).End(xlUp).Offset(1)

wb2.Close False

Next

End With

ChDir ("C:\Sales Reports")

Application.ScreenUpdating = True

End Sub

 

[NdNoviceHlp]

Hi howard. Maybe this code will help. You need to adjust the folder/directory path to suit. HTH. Dave

Dim TempFileDialog As FileDialog
Set TempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With TempFileDialog
.AllowMultiSelect = True
.ButtonName = "Open"
.Title = "Select Files"
.InitialFileName = "C:\TestFolder\"
.Filters.Clear
.Filters.Add "Excel files", "*.xlsm"
.Filters.Add "All files", "*.*"
.Show
'If TempFileDialog.Show = -1 Then
'Loop through all selected workbooks
'For i = 1 To TempFileDialog.SelectedItems.Count
End With

 

[NdNoviceHlp]

I should have added that you need to hold the shift button while selecting the files for multiselect. Also, I should have further commented how to use the selected files. Dave

Dim i As Integer, wb As Workbook
If TempFileDialog.Show = -1 Then
'Loop through all selected workbooks
For i = 1 To TempFileDialog.SelectedItems.Count
Set wb = Workbooks.Open(TempFileDialog.SelectedItems(i))
'do stuff
Next i
End If

 

[howard]

Thanks for the help Dave

I want to linmit my selection in the folder to the workbooks starting with below :

Bauten East
Prolem South
Prolem North


Kindly amend your code to accomodate this

 

[NdNoviceHlp]

If you just want those files, why use a file dialog at all? You can code directly to open only those files if you provide the entire file path for each file. If you want to use the file picker, you can trial this code. Dave

Sub Test()
Dim TempFileDialog As FileDialog
Dim i As Integer, wb As Workbook
Set TempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With TempFileDialog
.AllowMultiSelect = True
.ButtonName = "Open"
.Title = "Select Files"
.InitialFileName = "C:\TestFolder\"
.Filters.Clear
.Filters.Add "Excel files", "*.xlsm"
.Filters.Add "All files", "*.*"
End With
'ensure selection
If TempFileDialog.Show = -1 Then
'Loop through all selected workbooks
For i = 1 To TempFileDialog.SelectedItems.Count
If InStr(TempFileDialog.SelectedItems(i), "Bauten East") Or _
InStr(TempFileDialog.SelectedItems(i), "Prolem South") Or _
InStr(TempFileDialog.SelectedItems(i), "Prolem North") Then
Set wb = Workbooks.Open(TempFileDialog.SelectedItems(i))
'do stuff
End If
Next i
End If
End Sub

 

[howard]

Many Thanks Save

When using the file Pickers the file Dialog Box shows all the files in the folder

I only want to see files containing the following files below in the dialog box


Bauten East
Prolem South
Prolem North

 

[NdNoviceHlp]

Yes it shows them all, but the code will only process those specific workbooks (if they are selected). I am unaware of how to only show those files in the file dialog box unless they are the only files in the folder. Dave

 

[HongRu]

HTH

Sub sbOpenFiles()
    Application.ScreenUpdating = False
    Dim myPath
    myPath = "C:\Sales Reports by month\"
    
    Dim myFileName
    myFileName = Dir(myPath)
    
    Dim myCheck
    Do Until myFileName = ""
        If InStr(1, myFileName, ".xlsm") Then
            myCheck = InStr(1, myFileName, "Bauten East") + InStr(1, myFileName, "Prolen South") + InStr(1, myFileName, "Prolem North")
            If myCheck Then
                Application.Workbooks.Open myPath & myFileName
            End If
        End If
        myFileName = Dir()
    Loop
End Sub

 

[howard]

Many Thanks Save

When using the file Pickers the file Dialog Box shows all the files in the folder

I only want to see files containing the following files below in the dialog box


Bauten East
Prolem South
Prolem North

Thanks for all your effort Dave

 

[howard]

HTH

Sub sbOpenFiles()
    Application.ScreenUpdating = False
    Dim myPath
    myPath = "C:\Sales Reports by month\"
   
    Dim myFileName
    myFileName = Dir(myPath)
   
    Dim myCheck
    Do Until myFileName = ""
        If InStr(1, myFileName, ".xlsm") Then
            myCheck = InStr(1, myFileName, "Bauten East") + InStr(1, myFileName, "Prolen South") + InStr(1, myFileName, "Prolem North")
            If myCheck Then
                Application.Workbooks.Open myPath & myFileName
            End If
        End If
        myFileName = Dir()
    Loop
End Sub

Many Thanks for the help HongRu

Your code opens the workbooks which I require

I need you to kindly amend your code, so as to copy sheet2 from each on the specified workbooks containing "Bauten East", "Prolen South" and "Prolem North" and to paste these one below each other on sheet "imported data" in the destination workbook

Your assistance in this regard is most appreciated


I added code after your code as follows:

  With Sheets(2)
            .UsedRange.Copy _
                Destination:=ThisWorkbook.Sheets("Imported Data").Range("A" & Rows.Count).End(xlUp).Offset(1)

See full code below

 Sub sbOpenFiles()

  
  Application.ScreenUpdating = False
    Dim myPath
    myPath = "C:\Sales Reports by month\"
   
    Dim myFileName
    myFileName = Dir(myPath)
   
    Dim myCheck
    Do Until myFileName = ""
        If InStr(1, myFileName, ".xlsm") Then
            myCheck = InStr(1, myFileName, "Bauten East") + InStr(1, myFileName, "Prolen South") + InStr(1, myFileName, "Prolem North")
            If myCheck Then
                Application.Workbooks.Open myPath & myFileName
            End If
        End If
        myFileName = Dir()
    Loop

      With Sheets(2)
            .UsedRange.Copy _
                Destination:=ThisWorkbook.Sheets("Imported Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
              
End Sub