Inhalt UF-Listbox Export -zus. Header einfügen?
21.06.2007 11:24:49
Till
habe zu demselben Thema schon extrem gute Hilfe von Franz und Daniel bekommen.
Hier der alte Thread: https://www.herber.de/forum/messages/878360.html
Nun würde ich gerne in die erste Zeile der Txt-Datei folgende Werte ebenfalls Tabulator getrennt schreiben lassen, bevor sie endgültig gespeichert wird:
Datum Uhrzeit Spurart qKfz [ 1/h] qLkw [ 1/h] Vmittel [km/h] B [%] LOS [A-F] qA [1/min] qB [1/min] qC [1/min] qD [1/min] qE [1/min]
Ich hab mir diese Header-Werte (also als Kopfzeile) mal in eine Zeile der geöffneten Arbeitsmappe geschrieben, aber irgendwie klappt das nicht.
Geht es evtl. auch ohne den Umweg, also indem man die Daten direkt an die TXT-Datei vor dem Speichern übergibt?
Hier mal mein Versuch:
Private Sub Image9_Click()
MsgBox "Einen Moment bitte," & vbLf & "die Daten werden geschrieben.", vbInformation, " "
Dim i As Long
Dim j As Long
Dim sFile$, stext$, sTime$, sSep$, ungueltig As Variant, sZusatz$, iFilenr
iFilenr = FreeFile
sSep = Chr(9) 'Chr(9) ohne "" falls TAB Separierung erwünscht! Sonst ";"
sTime = Format(Now, "YYYYMMDD_hhmmss")
'Arrayvariable mit den ungültigen/unschönen Zeichen in Dateinamen
ungueltig = Array("""", "/", "\", ":", "|", "'", ".")
With Verkehr.ListBox1
'Zusatz für Dateinamen aus Listbox 2. Spalte, 1.Zeile
If .ColumnCount >= 1 Then
sZusatz = .List(1, 2)
'Zusatz ggf. kürzen
If Len(sZusatz) > 50 Then sZusatz = Left(sZusatz, 50)
'Zusatz auf ungültige Zeichen prüfen und ggf. durch "_" ersetzen
For i = LBound(ungueltig) To UBound(ungueltig)
If InStr(1, sZusatz, ungueltig(i)) > 0 Then
sZusatz = Application.WorksheetFunction.Substitute(sZusatz, ungueltig(i), "_")
'sZusatz = Replace(sZusatz, ungueltig(i), "_") 'nur in neueren Excelversionen
End If
Next
End If
sFile = ThisWorkbook.Path & Application.PathSeparator _
& "Datenexport_" & sTime & IIf(.ColumnCount >= 1, "_" & sZusatz, "") & ".txt"
Open sFile For Output As iFilenr
' Einfügen von Spaltenheaderinfo in TXT-Datei
Call Header 'fügt die Daten für die Headerinfo in die Zeile 40 des Sheets div_Diagramme ein
Dim rng As Range
Dim iRow As Integer, iCol As Integer, sTxt As String
Set rng = Excel.Application.Worksheets("div_Diagramme").Range("B40:M40").CurrentRegion
For iRow = 40 To 40
For iCol = 2 To 13
sTxt = sTxt & Cells(iRow, iCol).Value & sSep
Next iCol
Next iRow
' Ende Spaltenheader
For i = 0 To .ListCount - 1
stext = .List(i, 0)
For j = 1 To .ColumnCount - 1
stext = stext & sSep & .List(i, j)
Next
Print #iFilenr, stext
stext = ""
Next
Close iFilenr
End With
MsgBox "Datei wurde angelegt:" & vbLf & sFile, vbInformation, " "
End Sub
Interessant ist hier lediglich was zwischen
' Einfügen von Spaltenheaderinfo in TXT-Datei
und
' Ende Spaltenheader
steht.
Danke schon mal!
Gruß Till