Converting Macro that looks at a specific Folder to one that looks for a Directory.

[Falko26]

Hi Team,

I currently have a Macro that works perfectly by looking at a specific Folder for the files it is pulling data from. Is there a simple way to convert it so it uses the File Picker instead so I can chose which folder it is looking at each time I run the Macro?

Thanks in Advance.

Sub Test()

            Dim stgF As String, stgP As String
            Dim wb As Workbook
            Dim ws As Worksheet
            Set ws = "C:\Documents\General CAD\_Blank Project\Supporting Files\Weld Log\"
        
            stgP = Application.FileDialog(msoFileDialogFilePicker)
            stgF = Dir(stgP & "\*.xls*")
        

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

            Do While stgF <> vbNullString
            
                    Set wb = Workbooks.Open(stgP & "\" & stgF)
                
                    With wb.Sheets(1)
                            .UsedRange.Offset(1).Copy ws.Range("A" & Rows.Count).End(3)(2)
                            ws.Columns.AutoFit
                    End With
                
                            wb.Close Save = True
                            stgF = Dir()
            Loop
            
Columns("A:E").Select
Selection.ColumnWidth = 19
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Logit]

Option Explicit
Sub UseFileDialogOpen()


    'The following has been adapted from here:
    'https://msdn.microsoft.com/en-us/vba/excel-vba/articles/application-filedialog-property-excel


    Dim lngCount As Long


    'Open the file dialog
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        'Display paths of each file selected
        For lngCount = 1 To .SelectedItems.Count
            'MsgBox .SelectedItems(lngCount)
            CreateObject("Shell.Application").ShellExecute .SelectedItems(lngCount)
        Next lngCount
    End With


End Sub

 

[Falko26]

Hey Logit Thanks for the quick Reply,

however I'm not quite sure how to adapt that into my script. Essentially what my scrip does is copy data from a specific range from all workbooks in a specific folder and pastes that info in series to the master workbook I'm currently in. Right now whenever I need to switch the location I need to go into the VBA and paste the new location over the old one. I have other team members working with these macros and I'd rather not have them switching the Code Manually every time they need to switch folders.

If someone could take my code and adapt it to being able to pick the folder instead of relying on the specific path in the code that would be much appreciated.

I pasted my Test Macro before on accident please ignore that. Here is my actual Macro.

Thanks Again,

Sub BLC_Data_Combine()

            Dim stgF As String, stgP As String
            Dim wb As Workbook
            Dim ws As Worksheet
            Set ws = ActiveWorkbook.Worksheets("Reference")
        
            stgP = "C:\BLC- Blank Project\Isometric\Single Spool_ANSI-B\ProdIsos\Drawings\"  '---->Insert your file path.
            stgF = Dir(stgP & "\*.xls*")
        

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

            Do While stgF <> vbNullString
            
                    Set wb = Workbooks.Open(stgP & "\" & stgF)
                
                    With wb.Sheets(1)
                            .UsedRange.Offset(1).Copy ws.Range("A" & Rows.Count).End(3)(2)
                            ws.Columns.AutoFit
                    End With
                
                            wb.Close Save = True
                            stgF = Dir()
            Loop
            
Columns("A:E").Select
Selection.ColumnWidth = 19
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Falko26]

Hey Team,

I was able to figure it out. I added functions to find folder path using the folder picker then set my folder path to that.

Might not be the cleanest way of doing things but it did accomplish my goal.

Sub BLC_DataCombine()

            Dim stgF As String, stgP As String
            Dim wb As Workbook
            Dim ws As Worksheet
            Set ws = ActiveWorkbook.Worksheets("Reference")
        
                Dim fileExplorer As FileDialog
                Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)
                Dim folderPath As String

                    fileExplorer.AllowMultiSelect = False

                    With fileExplorer
                    If .Show = -1 Then 'Any folder is selected
                    folderPath = .SelectedItems.Item(1)
                    
                End If
                End With
                
            stgP = folderPath  '---->Insert your file path.
            stgF = Dir(stgP & "\*.xls*")
        

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

            Do While stgF <> vbNullString
            
                    Set wb = Workbooks.Open(stgP & "\" & stgF)
                
                    With wb.Sheets(1)
                            .UsedRange.Offset(1).Copy ws.Range("A" & Rows.Count).End(3)(2)
                            ws.Columns.AutoFit
                    End With
                
                            wb.Close Save = True
                            stgF = Dir()
            Loop
            
Columns("A:E").Select
Selection.ColumnWidth = 19
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Logit]

Good job !

Cheers.