Opgenomen VBA code aanpassen

[pvag]

Beste experts,

Vandaag ontving ik op mijn vorige vraag een passend antwoord van Jan Karel.
Het importeren van een CSV-bestand verliep perfect en het de procedure met de recorder opgenomen. Nu staat er in de code natuurlijk een vast path omdat ik het opgenomen heb. Nu zou ik graag de code aangepast willen hebben, zodat ik telkens een ander CSV-bestand kan kiezen. Natuurlijk kan ik in elk werkblad waarin geïmporteerd moet worden onderstaande code plakken, maar dat zou echter betekenen dat de CSV-bestanden altijd in het zelfde path moeten staan.

Wie kan me vooruit helpen/
Bij voorbaat dank.
Ton

Private Sub Imprt1eKw_Click()
         
         With ActiveSheet.QueryTables.Add(Connection:= _
         "TEXT;C:\Users\Ton\Downloads\INGB_1e_kwart.csv", Destination:=Range("$A$2"))
        .Name = "INGB_1e_kwart_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    End Sub

 

[edmoor]

Probeer het eens zo, je kan dan zelf het bestand selecteren:

Private Sub Imprt1eKw_Click()
    Dim Kiezen As Integer
    Dim Bestand As String

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        Kiezen = .Show
        If Kiezen <> 0 Then
            Bestand = .SelectedItems(1)
        End If
    End With

    If Bestand = "" Then Exit Sub
         
    With ActiveSheet.QueryTables.Add(Connection:= _
       "TEXT;" & Bestand, Destination:=Range("$A$2"))
       .Name = "INGB_1e_kwart_1"
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .TextFilePromptOnRefresh = False
       .TextFilePlatform = 850
       .TextFileStartRow = 1
       .TextFileParseType = xlDelimited
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
       .TextFileConsecutiveDelimiter = False
       .TextFileTabDelimiter = False
       .TextFileSemicolonDelimiter = False
       .TextFileCommaDelimiter = True
       .TextFileSpaceDelimiter = False
       .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
       .TextFileTrailingMinusNumbers = True
       .Refresh BackgroundQuery:=False
    End With
End Sub

 

[pvag]

Beste edmoor,

Bedankt voor je inzet.
Je code werkt perfect. Als ik het CSV-bestand het geïmporteerd komt alles netjes in het werkblad staan. PERFECT !!
Nogmaals hartelijk dank!!

Gr, Ton

 

[edmoor]

Graag gedaan