https://central.xero.com/s/article/Convert-a-TXT-file-to-CSV-format

Hej Robert

Til at samle filerne (txt eller csv) ville jeg bruge Shell-kommandoen således:

    Dim varShell
   
    varShell = Shell("cmd /c copy /b C:\xyz\Test\*.csv C:\xyz\Test\newfile.csv", vbMinimizedNoFocus)



Mvh Max

Og hvis den løsning virker for dit formål, skal du holde fast i den
For mig ser selve kodningen dog helt unødvendigt "knudret" ud.

Mvh Max

Det er også helt fair Hovedsagen er jo, at det virker for dig.

Jeg har (uden at teste det lokalt hos mig selv) prøvet at indbygge min kode-stump i din nuværende løsning. Så "sparer" du et antal loops, da der kun skal hentes data fra én samlet fil.

    Dim path            As String
    Dim FileName        As String
    Dim LastCell        As Range
    Dim Wkb            As Workbook
    Dim ws              As Worksheet
    Dim ThisWB          As String
  
    Dim sysXLS, tabel As Variant, ræk As Long, k As Long, antalKolonner As Long, antalK As Integer
    Dim linje As String
  
    Set sysXLS = ActiveWorkbook
    ræk = 1
  
    ThisWB = ThisWorkbook.Name
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    path = ActiveWorkbook.path & "\CSV\"

    ' Saml csv-filerne til én fil med navnet "samlet.csv" som ligger i din path
    Dim varShell
    varShell = Shell("cmd /c copy /b " & path & "*.csv " & path & "samlet.csv", vbMinimizedNoFocus)
  
    ' Sæt variablen FileName til navnet på den samlede csv-fil
    FileName = path & "samlet.csv"

    ' Her har jeg fjernet loopet med "Do until ..." fordi der nu kun er én samlet fil

            Open FileName For Input As #1
          
            While Not EOF(1)
                Line Input #1, linje
              
                tabel = Split(linje, ";")
                antalK = UBound(tabel)
             
                For k = 1 To antalK
                    sysXLS.Sheets(1).Range("B5").Cells(ræk, k) = tabel(k - 1)
                Next k
                ræk = ræk + 1
            Wend
            Close #1

        ' Er det ikke Sheets(1), som skal have auto-tilpasset kolonnebredderne?
        ' Data fra csv-filen indsættes i Sheets(1) - ikke Sheets(2) som angivet herunder
        sysXLS.Sheets(2).Columns.AutoFit

    Application.EnableEvents = True
    Application.ScreenUpdating = True
  
    Set Wkb = Nothing
    Set LastCell = Nothing
  
    Set sysXLS = Nothing

End Sub


Du kan jo prøve det, hvis du har tid og lyst


Mvh Max

Så mangler jeg kun det sidste
VBA coden som jeg gerne vil ændre,
sådan at den tager alle TXT filer i en mappe
på engang og laver dem om til nogle CSV filer,
i stedet for at den kun tager en af gangen som man vælger nu


Sub ConvertToCSV()
    Dim filePath: filePath = GetFilePath()
    
    If filePath <> "" Then
        
        Dim sCurrentLine, sTextHead As String, sText2 As String, iSectionLine As Integer
        Dim sText3 As String, sText4 As String, sText5 As String, sText6 As String
        
        Dim objFso As FileSystemObject: Set objFso = New FileSystemObject
        Set txtStream = objFso.OpenTextFile(filePath, ForReading, False)
        
        Dim baseName: baseName = objFso.GetBaseName(objFso.GetFile(filePath))
        
        ' Create a text file.
        Set tsFile = objFso.CreateTextFile(ThisWorkbook.path + "\CSV\" + (baseName) + ".CSV", True)
        
        Do While Not txtStream.AtEndOfStream
            sCurrentLine = txtStream.ReadLine
            
            If txtStream.Line = 4 Then
                sTextHead = sCurrentLine
            End If
            
            If (txtStream.Line > 9) Then
                If Left(sCurrentLine, 10) = "_______NEW" Then
                    iSectionLine = 0
                    
                    For iNumber = iStart To (iStart)
                        tsFile.WriteLine (baseName & ";" & sText2 & ";" & sText3 & ";" & sText4 & ";" & sText5 & ";" & sText6 & ";" & sTextHead & ";")
                    Next
                Else
                    iSectionLine = iSectionLine + 1
                    
                    If iSectionLine = 2 Then
                        sText2 = sCurrentLine
                    End If
                    
                    If iSectionLine = 3 Then
                        sText3 = sCurrentLine
                    End If
                    
                    If iSectionLine = 4 Then
                        sText4 = sCurrentLine
                    End If
                    
                    If iSectionLine = 5 Then
                        sText5 = sCurrentLine
                        End If
                    
                    If iSectionLine = 6 Then
                        sText6 = sCurrentLine
                    End If
                End If
            End If
        Loop
        ' Close data file.
        tsFile.Close
        txtStream.Close
        
        ' Create message.
        sMsg = "Konverteret til CSV-fil:" & vbNewLine & vbNewLine
        sMsg = sMsg & Trim(baseName) + ".CSV"
        
        ' Display message.
        MsgBox sMsg, vbInformation
    End If
End Sub

Function GetFilePath()
    ' Default return value.
    GetFilePath = ""

    ' Define the file dialog.
    Dim fileDialog As Office.fileDialog
    
    ' Create the file dialog.
    Set fd = Application.fileDialog(msoFileDialogFilePicker)
    
    With fd
    
        .AllowMultiSelect = False
        
        ' Set the title of the dialog box.
        .Title = "Please select the TXT-file."
        
        ' Clear out the current filters, and add our own.
        .Filters.Clear
        .Filters.Add "Data Files", "*.TXT"
        .Filters.Add "All Files", "*.*"
        
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
        If .Show = True Then
            GetFilePath = .SelectedItems(1) 'replace txtFileName with your textbox
        End If
    End With
End Function