Have user pick folder to run script

[realniceguy5000]

Hi,
I have a script that runs through all the workbooks in a folder However the path is hard coded. What I would like to do is use part of the hard code path but have the user pick the last folder that contains the files the script would run on. I tried to use the application getopenfile but that only picks the file itself not the folder.

Can someone help me modify this line of code to have the user pick the last folder?

Path = "C:\Documents and Settings\MAlston\Desktop\AS400 DATA\" & Application.GetOpenFilename("Excel Files (*.xls), *.xls")

Here is the entire script if it's of any help in solving the issue.

Thanks For your help, Mike

Option Explicit

Sub CombineSheetsFromAllFilesInADirectoryLA()
  
 Dim Path      As String
 Dim FileName  As String
 Dim tWB       As Workbook
 Dim tWS       As Worksheet
 Dim mWB       As Workbook
 Dim aWS       As Worksheet
 Dim RowCount  As Long
 Dim uRange    As Range
 Dim LastColm  As Range
 
 'Change as needed
 'Path = "G:\Hazleton Production\2009 Production\Individual Production\Large Area Pickers"
 'Path = "G:\Hazleton Production\2009 Production\Individual Production\Varsity Area Pickers"
 
 
 Path = "C:\Documents and Settings\MAlston\Desktop\AS400 DATA\" & Application.GetOpenFilename("Excel Files (*.xls), *.xls") 
 
 
 Application.EnableEvents = False
 Application.ScreenUpdating = False
 
    Set mWB = Workbooks.Add(1)
    Set aWS = mWB.ActiveSheet
 
    If Right(Path, 1) <> Application.PathSeparator Then
            Path = Path & Application.PathSeparator
    End If
            FileName = Dir(Path & "*.xls", vbNormal)
    Do Until FileName = ""
        If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
    Set tWB = Workbooks.Open(FileName:=Path & FileName)
                For Each tWS In tWB.Worksheets
    Set uRange = tWS.Range("A3", tWS.Cells(tWS.UsedRange.Row + tWS.UsedRange.Rows _
    .Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1))
        If RowCount + uRange.Rows.Count > 65536 Then
            aWS.Columns.AutoFit
    Set LastColm = aWS.Cells.Find(What:="*", after:=Range("IV"), _
      SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
        If LastColm.Column <> 255 Then
            aWS.Range(aWS.Columns(LastColm.Column + 1), aWS.Columns(255)).Delete
        End If
            RowCount = aWS.UsedRange.Rows.Count
    Set aWS = mWB.Sheets.Add(after:=aWS)
            RowCount = 0
        End If
        If RowCount = 0 Then
            aWS.Range("A1", aWS.Cells(1, uRange.Columns.Count)).Value = _
            tWS.Range("A1", tWS.Cells(1, uRange.Columns.Count)).Value
            aWS.Range("IV1").Value = "Source Sheet"
            RowCount = 1
        End If
    With aWS.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count)
            .Value = uRange.Value
            Intersect(.EntireRow, aWS.Columns("J")).Value = tWS.Name
    End With
            RowCount = RowCount + uRange.Rows.Count
                Next
            tWB.Close False
        End If
            FileName = Dir()
    Loop
 aWS.Columns.AutoFit
    Set LastColm = aWS.Cells.Find(What:="*", after:=Range("IV1"), _
  SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
        If LastColm.Column <> 255 Then
  aWS.Range(aWS.Columns(LastColm.Column + 1), aWS.Columns(255)).Delete
        End If
            RowCount = aWS.UsedRange.Rows.Count
    mWB.Sheets(1).Select
 Application.EnableEvents = True
 Application.ScreenUpdating = True
  
  
 Set tWB = Nothing
 Set tWS = Nothing
 Set mWB = Nothing
 Set aWS = Nothing
 Set uRange = Nothing
 Set LastColm = Nothing
End Sub

[dominicb]

Good afternoon realniceguy5000

Can someone help me modify this line of code to have the user pick the last folder?

The GetOpenFileName instruction is great, but as you pointed out it's only useful for selecting a file, and there is no ready made instruction for selecting a folder.

That said, there is a piece of code kicking around the internet that will allow you to open and utilise a "Browse for Folder" dialog, which seems perfect for your needs. John Walkenbach includes the whole code, plus a brief write up here.

HTH

DominicB

[romperstomper]

You can use this too:

Function GetFolder() As String
    Dim dlg As FileDialog
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
   ' start path
    dlg.InitialFileName = "C:\Test\"
    If dlg.Show = -1 Then
        GetFolder = dlg.SelectedItems(1)
    End If
End Function

[realniceguy5000]

You can use this too:

Function GetFolder() As String
    Dim dlg As FileDialog
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
   ' start path
    dlg.InitialFileName = "C:\Test\"
    If dlg.Show = -1 Then
        GetFolder = dlg.SelectedItems(1)
    End If
End Function

Super, This option works great... Thanks Mike

Also the link that dominicb provides has some great reading as well...

Thanks for the help, Mike