Textdatei direkt vom Webserver auslesen

Sub Test() Dim strTextfile As String Dim HTTP As Object Set HTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0") HTTP.Open "GET", "http://www.fsv-oppin.de/test.txt", False HTTP.Send strTextfile = HTTP.responseText MsgBox strTextfile End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Martin,
hier eine Alternative:


Option Explicit
' www.activevb.de/tipps/vb6tipps/tipp0227.html
' www.softgames.de/forum/frage114440.html
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" ( _
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 InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" ( _
ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, _
ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long _
) As Long
Private Declare Function InternetReadFile Lib "wininet" ( _
ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long _
) As Long
Private Declare Function InternetCloseHandle Lib "wininet" ( _
ByVal hInet As Long _
) As Long
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000
Function Get_Webfile(sURL As String) As String
Dim hOpen As Long, hFile As Long, strBuff As String, intA As Long
Const lngS As Long = 2048
hOpen = InternetOpen("ABC", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen Then
hFile = InternetOpenUrl( _
hOpen, sURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
If hFile Then
strBuff = Space(lngS)
Do
InternetReadFile hFile, strBuff, lngS, intA
Get_Webfile = Get_Webfile & Left(strBuff, intA)
Loop While intA > 0
InternetCloseHandle hFile
Else
Get_Webfile = "FEHLER hFile: " & hFile
End If
InternetCloseHandle hOpen
Else
Get_Webfile = "FEHLER hOpen: " & hOpen
End If
End Function
Private Sub Test_Get_Webfile()
Dim strU As String, strE As String, jj As Long
strU = "http://www.fsv-oppin.de/test.txt"
strE = Get_Webfile(strU)
Columns(1).Clear
Columns(1).NumberFormat = "@"
jj = 0
While Len(strE) > 100 * jj
Cells(jj + 1, 1) = Replace(Mid(strE, 100 * jj + 1, 100), vbLf, "")
jj = jj + 1
Wend
End Sub

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Beliebteste Forumthreads (12 Monate)

Textdatei direkt vom Webserver auslesen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread