EOF Prüfung
01.11.2004 18:12:05
Jens_Pu
habe mir eine Routine zum anpassen einer HTML-Telefonliste geschrieben.
Die beiden Schleifen Du Until EOF() bereiten mir Kopfzerbrechen.
Jede der beiden Schleifen macht immer eine Durchlauf zu viel.
In der Hilfe habe ich gefunden, daß EOF erst dann True wird, wenn kein kompletter Datensatz mehr eingelesen werden kann. Das Problem ist nur, so bekomme ich in jeder der beiden Schleifen die letzte Zeil doppelt in meine Zieldatei. Hat jemand eine Idee, wie ich das verhindern könnte?
Sub Convert_TelLi()
Dim strZeile As String
Dim strAlpha As String * 1
Dim strSeitenanfang As String
Dim strOut As String
Dim blnKopfGeloescht As Boolean
Dim lngDollPos As Long
Dim lngParaPos As Long
Dim iFile1 As Integer
Dim iFile2 As Integer
Dim iFile3 As Integer
strSeitenanfang = "<a href=" & Chr(34) & "#Seitenanfang" & Chr(34) & ">Seitenanfang"
blnKopfGeloescht = False
On Error Resume Next
Close
iFile1 = FreeFile
Open ThisWorkbook.Path & "\TelLi.txt" For Binary As #iFile1
iFile2 = FreeFile
Open ThisWorkbook.Path & "\Temp.txt" For Output As #iFile2
iFile3 = FreeFile
Open ThisWorkbook.Path & "\TelLiKopf.txt" For Binary As #iFile3
'Kopfdaten in Zielfile übertragen
Do Until EOF(iFile3)
Line Input #iFile3, strZeile
Print #iFile2, strZeile
Loop
Close #iFile3 'Kopfdatenfile schließen
Close #iFile2 'Tempdatei schließen
iFile2 = FreeFile
Open ThisWorkbook.Path & "\Temp.txt" For Append As #iFile2
Do Until EOF(1)
Line Input #1, strZeile
'Löschen der Kopfzeilen, bis die eigentliche Tabelle beginnt: letzte zu löschende Zeile enthält: <BODY>
Do While blnKopfGeloescht = False
If strZeile = "<BODY>" Then
blnKopfGeloescht = True
End If
Line Input #iFile1, strZeile
Loop
'Steuerzeichen positionen ermitteln
lngDollPos = InStr(1, strZeile, "$", 0)
lngParaPos = InStr(1, strZeile, "\'a7", 0)
'Zeilen analysieren und verarbeiten
strAlpha = ""
If lngDollPos > 0 Then '$ gefunden
If Mid(strZeile, lngDollPos + 2, 1) = "$" Then '$?$
strAlpha = Mid(strZeile, lngDollPos + 1, 1)
strOut = Left(strZeile, lngDollPos - 1) & "<a name=" & Chr(34) & strAlpha & Chr(34) & _
">" & strAlpha & "<" & Chr(47) & "a>" & Mid(strZeile, lngDollPos + 3)
End If
ElseIf lngParaPos > 0 Then '\'a7 gefunden
strOut = Left(strZeile, lngParaPos - 1) & strSeitenanfang & Mid(strZeile, lngParaPos + 1)
Else
strOut = strZeile 'KEINE Steuerzeichen gefunden
End If
'Dateiende analysieren und verarbeiten
If Right(strOut, 14) = "</BODY></HTML>" Then
strOut = Mid(strOut, 1, Len(strOut) - 14)
End If
Print #iFile2, strOut 'String in Temp-Datei schreiben
Loop
Close
Kill ThisWorkbook.Path & "\TelLi.htm"
Name ThisWorkbook.Path & "\Temp.txt" As ThisWorkbook.Path & "\TelLi.htm"
End Sub