Rubrik: Dateisystem · Dateien lesen/schreiben | VB-Versionen: VB6 | 09.06.08 |
Exceldatei im Format "TabStop-getrennt" einlesen II Wenn sich eine Excel-Tabelle nicht via ADO-Zugriff öffnen lässt, weil sie im Format "TabStop-getrennt" vorliegt, bietet diese Funktion eine Alternative. | ||
Autor: Norbert Grimm | Bewertung: | Views: 13.851 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Dieser Tipp ist eine Abwandlung des vor kurzem erschienenen Tipps: Exceldatei im Format "TabStop-getrennt" einlesen
Diesmal werden die Daten jedoch zunächst in ein ADO-Recordset eingelesen und dieses dann über die DataSource-Eigenschaft an das MSHFlexGrid-Control gebunden.
' AutomatisierungsCode für Excel_Dateien ' Autor : Norbert Grimm ' ' Einlesen einer Excel_Datei, die im Format [TabStopp getrennt] vorliegt. ' ' Die Datei wird als Text_Datei geöffnet u. der Inhalt ' in ein RecordSet-Object eingelesen. ' optional in einem MSHFlexGrid-Control angezeigt. ' ' Parameter : ' xlPath : Dateipfad ' adoObj : ADODB.Recordset ' Flex : MSHFlexGrid [optional]' ' ' Rückgabe : <>0, wenn Fehler Function Text_XLS_Ex(ByVal xlPath As String, _ ByRef adoObj As Object, _ Optional ByRef Flex As Object) As Long Dim A As Integer Dim B As Integer Dim C As Integer Dim D As Integer Dim F As Integer Dim I As Integer Dim intFF As Integer Dim L As Integer Dim P As Integer Dim S As Integer Dim Ret As Long Dim aDaten() As Variant Dim vDaten As Variant Dim errMsg As String Dim sTZ As String ' Trennzeichen On Error GoTo Err_TXLS intFF = FreeFile Open xlPath For Input Shared As intFF ' lies ganze Zeile Line Input #intFF, vDaten A = A + 1 C = -1 S = 1 sTZ = vbTab ' Chr(9) ' Anzahl Spalten ermitteln Do P = InStr(S, vDaten, sTZ) If P Then L = P - S C = C + 1 ReDim Preserve aDaten(C) aDaten(C) = Mid(vDaten, S, L) S = P + 1 End If Loop Until P = 0 ' Anzahl Spalten festlegen u. 1.AddNew With adoObj For F = 0 To C .Fields.Append "F" & F, adVariant, , adFldIsNullable Next F .CursorType = adOpenStatic .LockType = adLockOptimistic .Open adoFlag = .State .AddNew For I = 0 To C .Fields(I).Value = aDaten(I) Next I .Update ' Daten_Schleife Do While Not EOF(intFF) Line Input #intFF, vDaten ' Inhalte löschen For I = 0 To C aDaten(I) = "" Next I S = 1 D = -1 Do P = InStr(S, vDaten, sTZ) If P Then L = P - S D = D + 1 aDaten(D) = Mid(vDaten, S, L) S = P + 1 End If Loop Until P = 0 ' optionaler Zähler A = A + 1 ' Recordset füllen .AddNew For I = 0 To C .Fields(I).Value = aDaten(I) Next I .Update Loop End With Close intFF intFF = 0 ' Optionales Argument ' prüfe ob Flex übergeben wurde (intialisiert ist) If Not Flex Is Nothing Then With Flex Set .DataSource = adoObj End With End If Exit_TXLS: Text_XLS_Ex = Ret ' Datei noch offen If intFF Then Close intFF Exit Function Err_TXLS: With Err Ret = .Number errMsg = .Description .Clear End With MsgBox Ret & vbCr & errMsg, vbCritical, "Text_XLS_Ex" Resume Exit_TXLS End Function
Aufrufbeispiel:
Dim oRs As New ADODB.Recordset Text_XLS_Ex "D:\Mappe1.txt", oRs, MSHFlexGrid1