VBA to populate path to download folder and allow selection of multiple CSV files

[bgrove]

Hi,

Below is the code I'm using to import multiple csv files into one workbook (code I found on internet and pieced together). Works great!.....but everyone wants to use the macro but they don't want to manually select all the folders to get to the \download folder where the csv files are stored. Plus the path contains my userid which they will need to change when they use this macro.

I found a way to have the path reside in a cell A1 in the worksheet and each person can update with their user id BUT the folder dialog box does not have an OK button. Ugh!!

Any help would be GREATLY APPRECIATED!

Can this code be updated to populate the path in A1 of my spreadsheet?


Here is the path I'm using C:\Users\myuserid\AppData\Local\Packages\Microsoft.MicrosoftEdge_8wekyb3d8bbwe\TempState\Downloads

Sub ImportMultipleCSV()



Dim myfiles
Dim i As Integer
Dim strFilePath As String
myfiles = Application.GetOpenFilename(filefilter:="Report (*.csv), *.csv", MultiSelect:=True)
 Range("A3:AL100").Select
       Selection.ClearContents



If IsArray(myfiles) Then
    For i = LBound(myfiles) To UBound(myfiles)
         With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & myfiles(i), Destination:=Range("File_Path"))
            .Name = "myfiles"
            .FieldNames = False
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 2
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = ","
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With



    Next i
Else
    MsgBox "No File Selected"
    Exit Sub
End If


    Dim xConnect As Object
    For Each xConnect In ActiveWorkbook.Connections
        If xConnect.Name <> "ThisWorkbookDataModel" Then xConnect.Delete
    Next xConnect

    Kill "C:\Users\v-begrov\AppData\Local\Packages\Microsoft.MicrosoftEdge_8wekyb3d8bbwe\TempState\Downloads\*.*"
    MsgBox "File Deleted Successfully "


    Range("l:l,v:v").Select
    Cells.Replace What:="-", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Range("M:M,N:N,O:O").Select
        Range("O1").Activate
        Selection.NumberFormat = "m/d/yyyy"
        
End Sub