Getting a folder path to tie to a variable in my script

bobrandom123

New Member
Joined
Apr 19, 2012
Messages
11
I have this script that will go through a folder in which the path is hardcoded into the macro and consolidate all of the .csv files into the .xls I am working with utilizing Excel 2007.

Code:
Sub Consolidate()


Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet


    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False


    Set wbkNew = ThisWorkbook
    wbkNew.Activate
    
    'make sure the name of the first tab at the bottom of this xls file says Sheet1
    Sheets("Sheet1").Activate


    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub


    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        Cells.Clear
        NR = 1
    Else
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1
    End If


    OldDir = CurDir
    
    'select the directory path that has your csv files
    ' An example would be fPath = "C:\Documents and Settings\Administrator\My Documents\Scripts\test\"
    ' Make sure you put the backslash "\" at the end
    fPath = "\"
    
    'select the folder you want the csv files to be moved to once they are combined in the xls file
    ' An example would be fPathDone = "C:\Documents and Settings\Administrator\My Documents\Scripts\test\converted\"
    ' Make sure you put the backslash "\" at the end
    fPathDone = "\"
    
    ChDir fPath
    fName = Dir("*-*.csv")




    Do While Len(fName) > 0
            Set wbkOld = Workbooks.Open(fName)
            LR = Range("A" & Rows.Count).End(xlUp).Row
            Range("A2:A" & LR).EntireRow.Copy _
                wbkNew.Sheets("Sheet1").Range("A" & NR)
            wbkOld.Close True
            NR = Range("A" & Rows.Count).End(xlUp).Row + 1
            Name fPath & fName As fPathDone & fName
            fName = Dir
    Loop




    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True




    ChDir OldDir


End Sub
How can I use msoFileDialogFolderPicker to get the user to select the folder that their .csv files are located (fPath) and the folder they wish to have the files moved to once converted (fPathDone)? I think it would make things easier on the end user if they can select the folder instead of going in and manipulating the script.

Code:
    'select the directory path that has your csv files
    ' An example would be fPath = "C:\Documents and Settings\Administrator\My Documents\Scripts\test\"
    ' Make sure you put the backslash "\" at the end
    fPath = "\"
    
    'select the folder you want the csv files to be moved to once they are combined in the xls file
    ' An example would be fPathDone = "C:\Documents and Settings\Administrator\My Documents\Scripts\test\converted\"
    ' Make sure you put the backslash "\" at the end
    fPathDone = "\"
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,166
Try something like this...

Code:
    [color=green]' Prompt user to select the source folder[/color]
    [color=darkblue]With[/color] Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\Temp\"               [color=green]' Default path[/color]
        .Title = "Please Select the Source Folder"
        .ButtonName = "Select Folder"
        .AllowMultiSelect = [color=darkblue]False[/color]
        .Show
        [color=darkblue]If[/color] .SelectedItems.Count = 0 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]   [color=green]' User clicked cancel[/color]
        fPath = .SelectedItems.Item(1) & "\"
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=green]' Prompt user to select the destination folder[/color]
    [color=darkblue]With[/color] Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\Temp\"               [color=green]' Default path[/color]
        .Title = "Please Select the Destination Folder"
        .ButtonName = "Select Folder"
        .AllowMultiSelect = [color=darkblue]False[/color]
        .Show
        [color=darkblue]If[/color] .SelectedItems.Count = 0 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]   [color=green]' User clicked cancel[/color]
        fPathDone = .SelectedItems.Item(1) & "\"
    [color=darkblue]End[/color] [color=darkblue]With[/color]
 

Forum statistics

Threads
1,082,342
Messages
5,364,777
Members
400,815
Latest member
gangstar67

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top