vb@rchiv · Tipps & Tricks · Exceldatei im Format "TabStop-getrennt" einlesen II

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.843
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