AW: UF-Listbox Export in .txt aus 2 Listboxen?
23.06.2007 05:59:00
fcs
Hallo Till,
hier die angepasste Prozedur, so dass auch die Daten der 2. Listbox in die Textdatei geschrieben werden. Den Abschnitt zum schreiben der Spaltentitel hab ich etwas angepasst, so dass der Spaltentitel und Listboxeinträge sicher immer das gleiche Trennzeichen haben. Außerdem wird so das Problem umgangen, dass EXCEL97 nicht die Replace-Funktion unterstützt. Du has bisher übrigens nur 12 Spaltentitel festgelegt. Da du 13 Spalten in den beiden Listboxen hast muss du ggf. noch einen Spaltentitel ergänzen.
Gruß
Franz
Private Sub Image9_Click()
MsgBox "Einen Moment bitte," & vbLf & "die Daten werden geschrieben.", vbInformation, " "
Dim varHeader As Variant
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
'Arrayvariable mit Spaltentiteln
varHeader = Array("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]")
stext = varHeader(LBound(varHeader))
For j = LBound(varHeader) + 1 To UBound(varHeader)
stext = stext & sSep & varHeader(j)
Next
Print #iFilenr, stext
' 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
For j = 0 To Verkehr.ListBox2.ColumnCount - 1
stext = stext & sSep & Verkehr.ListBox2.List(i, j)
Next
Print #iFilenr, stext
Next
Close iFilenr
End With
MsgBox "Datei wurde angelegt:" & vbLf & sFile, vbInformation, " "
End Sub