CSV (txt) importeren met VBA - verschillende schrijfwijze van de code

[anton44]

Basis: Windows 10 Pro, Excel 2019.
Voor een aangepast projectje heb ik gebruik gemaakt van een reeks bestaande en goed werkende scripts, maar kom toch problemen tegen die ik niet zelf kan oplossen. Graag hulp.
Het specifieke probleem is het inladen van een csv data bestand (als txt bestand vanwege excel2019) in een werkblad (ImportRB).
Met het opnemen van de nodige stappen met de macrorecorder werkt alles naar behoren. Echter daar staan bestandsnamen en paden expliciet in vermeld. Deze gegevens wil ik laten ophalen uit het werkblad "variabelen". Bovendien wil ik de schrijfwijze door de recorder aanpassen aan die welke ik in een eerder project ook toegepast heb (met hulp van Helpmij specialisten ).
Dit blijkt toch niet goed te gaan. Na vele Try en Errors de witte vlag uitgestoken. Er wordt een enkele lege regel weggeschreven vanaf regel 8 of diverse kolommen worden naar rechts verschoven. Kortom: er gaat iets niet goed bij het inladen.

Onderstaande code waarbij de opnamerecorder is gebruikt

Sub RB01_IMPORTEREN() 'downloadbestand & inlezen

    Dim sFil As String
    Dim sPath As String
    Dim lRij As Long
    Dim TempName As String
    
    With Sheets("VariabelenRB")
        lRij = 1
        sFil = Dir(.Range("D15") & "\" & .Range("E15") & "*" & .Range("F15")) 'D15&E15&F15 is bestandsnaam met pad
        Do While sFil <> ""
            .Range("A" & lRij) = sFil
            lRij = lRij + 1
            sFil = Dir
        Loop
    End With

'Benoemen van tijdelijke bestandsnaam voor importeren
    With Sheets("VariabelenRB")
        TempName = .Range("H15") ‘H15 is bestandsnaam met pad
        If Len(TempName) > 0 Then
            TempName = .Range("H15")
        Else:
            MsgBox "Bestand is niet gevonden", vbInformation, "Onvindbaar"
            'Macro stopt bij "Bestand is niet gevonden" / Start de volgende sub niet.
            GoTo Fout
       End If
    End With
    
    Call RB102_Ophalen

Fout:
    Call RB_Opruimen
    End Sub
    

 Sub RB02_Ophalen()

'Mutatiebestand Importen / '   Vereenvoudiging voor "Omschrijving"
 '   Dim BESTAND As String
 '   BESTAND = Sheets("ImportRB").Range("A2").Value

    Workbooks.OpenText Filename:="D:\Downloads\TR-Info.TXT", Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=True, Comma:=False, _
        Space:=False, Other:=False,
        FieldInfo:=Array(Array(1, 4), Array(2, 2), Array( _
        3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 1), Array(10 _
        , 2), Array(11, 1), Array(12, 4), Array(13, 4), Array(14, 2), Array(15, 2), Array(16, 2), _
        Array(17, 2), Array(18, 2), Array(19, 2)), DecimalSeparator:=".", _
        TrailingMinusNumbers:=True
        
    Windows("TR-Info.TXT").Activate
    Rows("1:7").Select
    Selection.Copy
    Range("A5").Select
    Windows("Afrekening 2019.xlsm").Activate
    Sheets("ImportRB").Select
    Rows("8:8").Select
    ActiveSheet.Paste
    Range("A8").Select
    Windows("Afrekening 2019.xlsm").Activate
    Range("A8").Select
    
    Workbooks.Open Filename:="D:\Downloads\TR-Info.TXT"
    ActiveWorkbook.Save
    ActiveWorkbook.Close
     
    Dim TempName As String
    TempName = "d:\downloads\TR-Info.txt"
    If Len(TempName) > 0 Then
   ' Else
    '        GoTo Fout2
    End If
    Call RB03_Kolomschikking
     
End Sub

Onderstaand die van mijn poging voor een andere schrijfwijze (niet werkend)
Als extra probleempje: in het CSV staan getallen met een decimaalpunt (100.00), die omgezet moeten worden een decimaalkomma (100,00)
In het werkende script gerealiseerd door DecimalSeparator:="."

Sub RB101_IMPORTEREN() 'downloadbestand inlezen

    Application.ScreenUpdating = False

    Dim sFil As String
    Dim sPath As String
    Dim lRij As Long
    Dim TempName As String
    
    With Sheets("VariabelenRB")
          lRij = 1
        sFil = Dir(.Range("D15") & "\" & .Range("E15") & "*" & .Range("F15")) 'D15&E15&F15 is bestandsnaam met pad
        Do While sFil <> ""
            .Range("A" & lRij) = sFil
            lRij = lRij + 1
            sFil = Dir
        Loop
    End With

'Benoemen van tijdelijke bestandsnaam voor importeren
    With Sheets("VariabelenRB")
        TempName = .Range("H15")
        If Len(TempName) > 0 Then
            TempName = .Range("H15")
        Else:
            MsgBox "Bestand is niet gevonden", vbInformation, "Onvindbaar"
            'Macro stopt bij "Bestand is niet gevonden" / Start de volgende sub niet.
            GoTo Fout1
       End If
     
    End With
    
    Call RB02_Ophalen
    
Fout1:
    Call RB_Einde
    
    End Sub

    Sub RB102_Ophalen()
  
'Mutatiebestand Importen

      Application.ScreenUpdating = False
     
     With Sheets("VariabelenRB")
      Dim TempName1 As String
      Dim TempName2 As String
      Dim TempName3 As String
      TempName1 = .Range("H15") 'd:\downloads\TR-Info.txt
      TempName2 = .Range("G15") 'TR-Info.txt
      TempName3 = .Range("J15") 'Afrekening 2019.xlsm
     End With
      
     ActiveWorkbook.Worksheets("ImportRB").Select
     With ActiveSheet.QueryTables.Add(Connection:= _
     "TEXT;" & TempName1, Destination:=Range("$A$8"))
      '  .Name =
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(4, 2, 2, 2, 2, 2, 2, 2, 1, 2, 1, 4, 4, 2, 2, 2, 2, 2, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False

    End With
   
    Application.ScreenUpdating = True
     
    Call RB103_Kolomschikking
     
End Sub