See my comment at the bottom.
'=======================================
Option Explicit
Private Declare Function InternetOpen Lib "wininet.dll" 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.dll" Alias "InternetOpenUrlA" _
(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 Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, _
ByVal sBuffer As String, _
ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Public Function fncGetInternetFile(URLocation As String, _
Optional OutputFileName As String = vbNullString) As String
'retrieves a remote file (http, ftp, etc.) and returns its contents in a string;
'if an OutputFileName has been specified, it also saves the file in the specified local location
'in case of an error it returns:
' "Error 0": an unexpected error occured
' "Error 1": internet connection could not be established
' "Error 2": the URL file could not be found/accessed
' "Error 3": the URL file was opened but contains no data
' "Error 4": the specified directory of filename for
' saving the remote data is invalid
'
'variable declarations
Dim OpenInternetConnection As Long
Dim OpenURLocation As Long
Dim ContinueDataCollection As Boolean
Dim DataChunkRetrieved As Boolean
Dim NumberOfBytestoRead As String * 2048
Dim NumberOfBytesRead As Long
Dim File_hWnd As Long
'
'required constants for the wininet.dll
Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0
Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Const INTERNET_OPEN_TYPE_PROXY As Long = 3
Const INTERNET_FLAG_RELOAD As Long = &H80000000
'
'initiate the result of the function to "Error 0"; assume unexpected failure
fncGetInternetFile = vbNullString
'
'establish Internet connection
OpenInternetConnection = InternetOpen(sAgent:="VB OpenUrl", _
lAccessType:=INTERNET_OPEN_TYPE_PRECONFIG, _
sProxyName:=vbNullString, _
sProxyBypass:=vbNullString, _
lFlags:=0)
'if Internet connection could not be established exit the function; return "Error 1"
If OpenInternetConnection = 0 Then: fncGetInternetFile = "Error 1": GoTo ExitFunction
'
'open the specified Internet URLocation
OpenURLocation = InternetOpenUrl(hOpen:=OpenInternetConnection, _
sUrl:=URLocation, _
sHeaders:=vbNullString, _
lLength:=0, _
lFlags:=INTERNET_FLAG_RELOAD, _
lContext:=0)
'if the specified Internet URL could not be opened exit the function; return "Error 2"
If OpenURLocation = 0 Then: fncGetInternetFile = "Error 2": GoTo ExitFunction
'
'read the specified file in chunks of 2048 bytes, and store the data
'in the output of the function
ContinueDataCollection = True
fncGetInternetFile = vbNullString
While ContinueDataCollection = True
NumberOfBytestoRead = vbNullString
DataChunkRetrieved = InternetReadFile(hFile:=OpenURLocation, _
sBuffer:=NumberOfBytestoRead, _
lNumBytesToRead:=Len(NumberOfBytestoRead), _
lNumberOfBytesRead:=NumberOfBytesRead)
fncGetInternetFile = fncGetInternetFile & Left$(NumberOfBytestoRead, NumberOfBytesRead)
If Not CBool(NumberOfBytesRead) Then ContinueDataCollection = False
Wend
'
'if the result of the function is not empty and there is a request for saving the file
'in a specified location in a local drive, open a file for binary access and pass the data
'into it
If Not OutputFileName = vbNullString Then
If Not fncGetInternetFile = vbNullString Then
File_hWnd = FreeFile
On Error Resume Next
Open OutputFileName For Binary Access Write As File_hWnd
If Err.Number = 0 Then
Put File_hWnd, , fncGetInternetFile
Else
'return "Error 4"; the specified file name or path is invalid
fncGetInternetFile = "Error 4"
End If
Else
'return "Error 3" if the remote file contains no data"
fncGetInternetFile = "Error 3": GoTo ExitFunction
End If
End If
'
ExitFunction:
'
On Error Resume Next
'close the handle to the remote file and the internet connection
If Not OpenURLocation = 0 Then InternetCloseHandle (OpenURLocation)
If Not OpenInternetConnection = 0 Then InternetCloseHandle (OpenInternetConnection)
'close the handle to the local file
Close File_hWnd
On Error GoTo 0
'
End Function
'=======================================
Sub test1_fncGetInternetFile()
'saving a binary format file in a file
Dim RemoteFileContents As String
Dim URL As String
Dim OutputFile As String
URL = "
http://www.dreslough.com/main/bandw/horsehead.gif"
OutputFile = "c:\horsehead.gif"
RemoteFileContents = fncGetInternetFile(URLocation:=URL, _
OutputFileName:=OutputFile)
If Not Left(RemoteFileContents, 5) = "Error" Then
MsgBox Prompt:="The contents of:" & Chr(10) & _
URL & Chr(10) & _
"have been suceesfully saved in:" & Chr(10) & _
OutputFile
Else
MsgBox Prompt:="No data could be retrieved from the specified location" & Chr(10) & _
"(" & RemoteFileContents & ")"
End If
End Sub
'=======================================
the above code (posted previously by Rob Bovey), worked for me:
The test1_fncGetInternetFile function at the bottom is where you enter your URL and you run that function.
