Hi werner,
Die For-Next oder Do-Loop Schleifen brauche ich alle.
Naja, um das zu beurteilen bräuchte ich ne Glaskugel 
Nachfolgend habe ich einen VBA-Code (von einem VB-Forum zusammengebastelt) der eine Html-Datei am Stück einliest und in eine Textdatei schreibt, Er ist sehr schnell. Vielleicht kannst du Teile davon gebrauchen. Sub test() musste dir anpassen.
Gruß
Reinhard
Private Declare Sub InternetCloseHandle Lib "wininet.dll" ( \_
ByVal hInet As Long)
Private Declare Function InternetOpenA Lib "wininet.dll" ( \_
ByVal sAgent As String, ByVal lAccessType As Long, \_
ByVal sProxyName As String, ByVal sProxyBypass As String, \_
ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrlA Lib "wininet.dll" ( \_
ByVal hOpen As Long, ByVal sUrl As String, \_
ByVal sHeaders As String, ByVal lLength As Long, \_
ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Sub InternetReadFile Lib "wininet.dll" ( \_
ByVal hFile As Long, ByVal sBuffer As String, \_
ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long)
'Enumeration für Internet:
Public Enum InternetOpenType
IOTPreconfig = 0
IOTDirect = 1
IOTProxy = 3
End Enum
Sub test()
Dim s As String, n As Integer
For n = 1 To 7
s = OpenURL(Range("B" & n).Value)
WriteFile Range("a" & n).Value, s
Next n
End Sub
Public Function FileExists(Path As String) As Boolean
Const NotFile = vbDirectory Or vbVolume
On Error Resume Next
FileExists = (GetAttr(Path) And NotFile) = 0
On Error GoTo 0
End Function
Function ReadFile(ByRef Path As String) As String
Dim FileNr As Long
'Falls nicht vorhanden, nichts zurückgeben:
On Error Resume Next
If FileLen(Path) = 0 Then Exit Function
On Error GoTo 0
'Datei einlesen:
FileNr = FreeFile
Open Path For Binary As #FileNr
ReadFile = Space$(LOF(FileNr))
Get #FileNr, , ReadFile
Close #FileNr
End Function
Sub WriteFile(ByRef Path As String, ByRef Text As String)
Dim FileNr As Long
'Wenn Datei unverändert, dann abbrechen (ggf. weglassen):
If FileExists(Path) Then \_
If FileLen(Path) = Len(Text) Then \_
If ReadFile(Path) = Text Then Exit Sub
'Text speichern:
FileNr = FreeFile
Open Path For Output As #FileNr
Print #FileNr, Text;
Close #FileNr
End Sub
Public Function OpenURL( \_
ByVal URL As String, \_
Optional ByVal OpenType As InternetOpenType = IOTPreconfig \_
) As String
Const INET\_RELOAD = &H80000000
Dim hInet As Long
Dim hURL As Long
Dim Buffer As String \* 2048
Dim Bytes As Long
'Inet-Connection öffnen:
hInet = InternetOpenA( \_
"VB-Tec:INET", OpenType, \_
vbNullString, vbNullString, 0)
hURL = InternetOpenUrlA( \_
hInet, URL, vbNullString, 0, INET\_RELOAD, 0)
'Daten sammeln:
Do
InternetReadFile hURL, Buffer, Len(Buffer), Bytes
If Bytes = 0 Then Exit Do
OpenURL = OpenURL & Left$(Buffer, Bytes)
Loop
'Inet-Connection schließen:
InternetCloseHandle hURL
InternetCloseHandle hInet
End Function
