Lidt special TXT fil til CSV fil
Har prøvet i Excel gruppen uden held, så prøver lige herhå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