Hier mein Code:
Option Explicit
Const path = "d:\"
Private Type Satz1
feld1 As String * 10
feld2 As String * 30
feld3 As String * 36
End Type
Private Type Satz2
feld1 As String * 10
feld2 As String * 5
feld3 As String * 30
End Type
Private Type Satz3
feld1 As String * 10
feld2 As String * 10
feld3 As String * 10
feld4 As String * 5 'Leerstelle
feld5 As String * 1
feld6 As String * 1 'Leerstelle
feld7 As String * 4
feld8 As String * 3 'Leerstelle
feld9 As String * 4
feld10 As String * 8 'Leerstelle
feld11 As String * 2
feld12 As String * 2
feld13 As String * 1 'Leerstelle
feld14 As String * 5
feld15 As String * 1 'Leerstelle
feld16 As String * 4
feld17 As String * 2 'Leerstelle
feld18 As String * 2
End Type
Private Type Satz4
feld1 As String * 10
feld2 As String * 1 'Leerstelle
feld3 As String * 6
feld4 As String * 3 'Leerstelle
feld5 As String * 11
feld6 As String * 2 'Leerstelle
feld7 As String * 12
feld8 As String * 4
feld9 As String * 1 'Leerstelle
feld10 As String * 3
feld11 As String * 2 'Leerstelle
feld12 As String * 5
feld13 As String * 3 'Leerstelle
feld14 As String * 4
feld15 As String * 1 'Leerstelle
feld16 As String * 4
feld17 As String * 4
End Type
Sub Einlesen()
Dim Line As Integer
Dim SatzArt As String * 2
Dim RestOfLine As String * 78
Dim RestOfLine2 As String * 76
Dim SatzNum As String * 2
Dim NewLine As String * 2
Dim tSatz1 As Satz1
Dim tSatz2 As Satz2
'Dim tSatz3 As Satz3
'Dim tSatz4 As Satz4
Open path & "\WIESENTAL.H" For Binary As #1
While Not EOF(1)
Line = Line + 1
Get #1, , SatzArt
ActiveSheet.Cells(Line, 1) = SatzArt
If SatzArt = "H " Then
Get #1, , RestOfLine
ActiveSheet.Cells(Line, 2) = RestOfLine
Else
Get #1, , SatzNum
ActiveSheet.Cells(Line, 2) = SatzNum
Select Case SatzNum
Case " 1"
Get #1, , tSatz1
ActiveSheet.Cells(Line, 3) = tSatz1.feld1
ActiveSheet.Cells(Line, 4) = tSatz1.feld2
ActiveSheet.Cells(Line, 5) = tSatz1.feld3
Case " 2"
Get #1, , tSatz2
ActiveSheet.Cells(Line, 3) = tSatz2.feld1
ActiveSheet.Cells(Line, 4) = tSatz2.feld3
' Case " 3"
' Get #1, , tSatz3
' ActiveSheet.Cells(Line, 3) = tSatz3.feld1
' ActiveSheet.Cells(Line, 4) = tSatz3.feld2
' ActiveSheet.Cells(Line, 5) = tSatz3.feld3
' ActiveSheet.Cells(Line, 6) = tSatz3.feld5
' ActiveSheet.Cells(Line, 7) = tSatz3.feld7
' ActiveSheet.Cells(Line, 8) = tSatz3.feld9
' ActiveSheet.Cells(Line, 9) = tSatz3.feld11
' ActiveSheet.Cells(Line, 10) = tSatz3.feld12
' ActiveSheet.Cells(Line, 11) = tSatz3.feld14
' ActiveSheet.Cells(Line, 12) = tSatz3.feld16
' ActiveSheet.Cells(Line, 13) = tSatz3.feld18
' Case " 4"
' Get #1, , tSatz4
' ActiveSheet.Cells(Line, 3) = tSatz4.feld1
' ActiveSheet.Cells(Line, 4) = tSatz4.feld3
' ActiveSheet.Cells(Line, 5) = tSatz4.feld5
' ActiveSheet.Cells(Line, 6) = tSatz4.feld7
' ActiveSheet.Cells(Line, 7) = tSatz4.feld8
' ActiveSheet.Cells(Line, 8) = tSatz4.feld10
' ActiveSheet.Cells(Line, 9) = tSatz4.feld12
' ActiveSheet.Cells(Line, 10) = tSatz4.feld14
' ActiveSheet.Cells(Line, 11) = tSatz4.feld16
' ActiveSheet.Cells(Line, 12) = tSatz4.feld17
Case Else
Get #1, , RestOfLine2
End Select
End If
Get #1, , NewLine
Wend
Close #1
End Sub
Case 3 und 4 funktionieren nicht, wer die Texdatei mal geschickt haben möchte und mir helfen möchte kann mir ja mal mailen, wär echt super, wenn mir jemand helfen könnte!
Gruß
Fabian Bussweiler