1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
| Sub Read_DB()
Dim dlg As New dlgFile
Dim objTextStream As Object
Dim strLine As String
Dim strMerker As String
Dim nIndex As Integer
nIndex = 10
If CheckWorksheet Then
dlg.dlgFindDBFile.ShowOpen
Application.ScreenUpdating = False
If dlg.dlgFindDBFile.FileName <> "" Then
Worksheets("DB").Range("A9:E32767").ClearContents
Worksheets("DB").Range("A9:E32767").Select
Selection.Interior.ColorIndex = xlNone
Set objTextStream = g_objFst.OpenTextFile(dlg.dlgFindDBFile.FileName, 1)
If Not (objTextStream Is Nothing) Then
'den Anfang suchen
Do While objTextStream.AtEndOfStream <> True
strLine = objTextStream.Readline
If InStr(1, strLine, "DATA_BLOCK", vbTextCompare) > 0 Then
'DB-Anfang gefunden
If InStr(1, strLine, " DB ") > 0 Then
Worksheets("DB").Cells(1, 3) = Trim(Mid(strLine, InStr(InStr(1, strLine, "DATA_BLOCK", vbTextCompare) + 10, _
strLine, "DB", vbTextCompare) + 2))
Else
Worksheets("DB").Cells(1, 3) = Trim(Mid(strLine, InStr(InStr(1, strLine, "DATA_BLOCK", vbTextCompare) + 10, _
strLine, """", vbTextCompare) + 1))
Worksheets("DB").Cells(1, 3) = Mid(Worksheets("DB").Cells(1, 3), 1, Len(Worksheets("DB").Cells(1, 3)) - 1)
End If
Exit Do
End If
Loop
Do While objTextStream.AtEndOfStream <> True
strLine = objTextStream.Readline
If InStr(1, strLine, "TITLE", vbTextCompare) > 0 Then
Worksheets("DB").Cells(3, 2) = Trim(Mid(strLine, InStr(InStr(1, strLine, "TITLE", vbTextCompare) + 5, _
strLine, "=", vbTextCompare) + 1))
ElseIf InStr(1, strLine, "AUTHOR", vbTextCompare) > 0 Then
Worksheets("DB").Cells(3, 2) = Trim(Mid(strLine, InStr(InStr(1, strLine, "AUTHOR", vbTextCompare) + 6, _
strLine, ":", vbTextCompare) + 1))
ElseIf InStr(1, strLine, "FAMILY", vbTextCompare) > 0 Then
Worksheets("DB").Cells(4, 2) = Trim(Mid(strLine, InStr(InStr(1, strLine, "FAMILY", vbTextCompare) + 6, _
strLine, ":", vbTextCompare) + 1))
ElseIf InStr(1, strLine, "NAME", vbTextCompare) > 0 Then
Worksheets("DB").Cells(5, 2) = Trim(Mid(strLine, InStr(InStr(1, strLine, "NAME", vbTextCompare) + 4, _
strLine, ":", vbTextCompare) + 1))
ElseIf InStr(1, strLine, "VERSION", vbTextCompare) > 0 Then
strMerker = Trim(Mid(strLine, InStr(InStr(1, strLine, "VERSION", vbTextCompare) + 7, _
strLine, ":", vbTextCompare) + 1))
Worksheets("DB").Cells(6, 2) = Left(strMerker, InStr(1, strMerker, "."))
Worksheets("DB").Cells(6, 3) = Right(strMerker, Len(strMerker) - InStr(1, strMerker, "."))
ElseIf InStr(1, strLine, "BEGIN", vbTextCompare) > 0 Then
'die Aktualwerte einlesen
ReadNextAktValue strLine, objTextStream, nIndex
Else
'die Variablen einlesen
ReadNextVar strLine, nIndex
End If
Loop
objTextStream.Close
Else
MsgBox "File not found"
End If
End If
Application.ScreenUpdating = False
Worksheets("DB").Cells(1, 1).Select
Set dlg = Nothing
End If
End Sub |
