Avatar billede Bjerget Praktikant
01. oktober 2018 - 20:50

Lidt special TXT fil til CSV fil

Har prøvet i Excel gruppen uden held, så prøver lige her
håber det er ok

jeg har noget VBA code som jeg gerne vil ændre, sådan at den tager alle de TXT filer, som jeg har liggere i den samme mappe som EXCEL filen 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.

Tekst filen ser sådan ud

sTextHead1
sTextHead2
sTextHead3
sTextHead4
sTextHead5
sTextHead6
sTextHead7
_____HEAD_____
sText1
sText2
sText3
sText4
sText5
sText6
_______NEW_______
sText1
sText2
sText3
sText4
sText5
sText6
_______NEW_______


og her er VBA koden

Sub ConvertToCSV()
    Dim filePath: filePath = GetFilePath()
   
    If filePath <> "" Then
       
        Dim sCurrentLine, sTextHead3 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\" + Trim(baseName) + ".CSV", True)
       
        Do While Not txtStream.AtEndOfStream
            sCurrentLine = txtStream.ReadLine
           
            If txtStream.Line = 4 Then
                sTextHead3 = 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 & ";" & sTextHead3 & ";")
                    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
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester



Seneste spørgsmål Seneste aktivitet
I dag 06:10 Excel åbner fil i kæmpe format Af Aske i Excel
I går 22:00 Datafordeler Af Lsk i PHP
I går 12:37 Summere beløb pr. dato Af TTA i Excel
31/1022:44 Tilslutte chassic fans Af viking69 i PC
31/1020:28 LED lysstofrør Af ErikHg i Fri debat