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

Falko26

New Member
Joined
Oct 13, 2021
Messages
19
Office Version
  1. 365
Platform
  1. Windows
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.

Code:
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
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,319
VBA Code:
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

New Member
Joined
Oct 13, 2021
Messages
19
Office Version
  1. 365
Platform
  1. Windows
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,

VBA Code:
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

New Member
Joined
Oct 13, 2021
Messages
19
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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
 
Solution
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,045
Messages
5,767,810
Members
425,437
Latest member
blaix

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top