Here's a function to download a URL to a text file. This is used in
production by several large banks - it's part of a larger library I wrote,
but this will set you on the right path...
As a friendly hint, avoid using the Internet Explorer libraries at all costs
- they suck!
--declares
'Constants
Private Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_SERVICE_FTP = 1
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const rDayZeroBias As Double = 109205# ' Abs(CDbl(#01-01-1601#))
Private Const rMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# /
10000#
'Windows 32 bit API declarations
Private Declare Function InternetOpen Lib "wininet.dll" Alias
"InternetOpenA" _
(ByVal lpszAgent As String, ByVal dwAccessType As Long, _
ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal
dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" 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.dll" (ByVal hFile As _
Long, ByVal lpBuffer As String, ByVal dwNumberOfBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime
As Any, lpLocalFileTime As Any) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet
As Long) As Integer
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String,
lpdwCurrentDirectory As Long) As Boolean
Private Declare Function InternetConnect Lib "wininet.dll" Alias
"InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, ByVal
nServerPort As Integer, _
ByVal sUsername As String, ByVal sPassword As String, ByVal lService As
Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal
dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
'Private Const FTP_TRANSFER_TYPE_BINARY = &H2
'Private Const NO_ERROR = 0
'Private Const FILE_ATTRIBUTE_READONLY = &H1
'Private Const FILE_ATTRIBUTE_HIDDEN = &H2
'Private Const FILE_ATTRIBUTE_SYSTEM = &H4
'Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
'Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
'Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
'Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
'Private Const FILE_ATTRIBUTE_OFFLINE = &H1000
'Private Const INTERNET_FLAG_PASSIVE = &H8000000
'Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
'Private Const ERROR_NO_MORE_FILES = 18
'Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias
"InternetFindNextFileA" _
(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
'Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias
"FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal
dwContent As Long) As Long
'Private Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As Long, _
dwNumberOfBytesWritten As Long) As Integer
'Private Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long,
ByVal Flags As Long, ByVal Context As Long) As Long
'Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
'Private Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
'Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(ByRef lpdwError As Long, _
ByVal lpszErrorBuffer As String, _
ByRef lpdwErrorBufferLength As Long) As Boolean
'Private Declare Function FormatMessage Lib "kernel32" Alias
"FormatMessageA" _
(ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
Arguments As Long) As Long
'Private Declare Function GetModuleHandle Lib "kernel32" Alias
"GetModuleHandleA" (ByVal lpLibFileName As String) As Long
Private Function CopyURLToFile(ByVal URL As String, ByVal FileName As
String) As Boolean
'Constants
Const strMethodName As String = "ETFSheetEngine.CopyURLToFile "
'variables
Dim hInternetSession As Long
Dim hUrl As Long
Dim FileNum As Integer
Dim ok As Boolean
Dim NumberOfBytesRead As Long
Dim Buffer As String
Dim fileIsOpen As Boolean
940 On Error GoTo ErrorHandler
950 CopyURLToFile = False
960 If oFSO Is Nothing Then
970 Set oFSO = New Scripting.FileSystemObject
980 End If
' open an Internet session, and retrieve its handle
990 hInternetSession = InternetOpen(App.EXEName,
INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
1000 If hInternetSession = 0 Then
1010 Err.Raise vbObjectError + 1000, , "An error occurred calling
InternetOpen function"
1020 Else
' open the file and retrieve its handle
1030 hUrl = InternetOpenUrl(hInternetSession, URL, vbNullString, 0,
INTERNET_FLAG_EXISTING_CONNECT, 0)
1040 If hUrl = 0 Then
1050 Err.Raise vbObjectError + 1000, , "An error occurred calling
InternetOpenUrl function"
1060 Else
' open the local file
1070 FileNum = FreeFile
1080 Open FileName For Binary As FileNum
1090 fileIsOpen = True
' prepare the receiving buffer
1100 Buffer = Space(4096)
1110 Do
' read a chunk of the file - returns True if no error
1120 ok = InternetReadFile(hUrl, Buffer, Len(Buffer),
NumberOfBytesRead)
' exit if error or no more data
1130 If NumberOfBytesRead = 0 Or Not ok Then
1140 Exit Do
1150 End If
' save the data to the local file
1160 Put #FileNum, , Left$(Buffer, NumberOfBytesRead)
1170 Loop
1180 End If
1190 End If
1200 CopyURLToFile = True
' flow into the error handler
ErrorHandler:
' close the local file, if necessary
1210 If fileIsOpen Then
1220 Close #FileNum
1230 End If
' close internet handles, if necessary
1240 If hUrl Then
1250 InternetCloseHandle hUrl
1260 End If
1270 If hInternetSession Then
1280 InternetCloseHandle hInternetSession
1290 End If
' report the error to the client, if there is one
1300 If Err Then
1310 With Err
1320 gstrErrorDescription = .Description
1330 glngErrorNumber = .Number
1340 gstrErrorHelpContext = .HelpContext
1350 gstrErrorHelpFile = .HelpFile
1360 gstrErrorSource = .Source
1370 glngErrorLine = Erl
1380 .Clear
1390 End With
1400 CopyURLToFile = False
1410 RaiseEvent BadgerMessage(strMethodName & gstrErrorDescription
& "(" & glngErrorNumber & ") [" & gstrErrorSource & "]<" & glngErrorLine & ">
")
1420 If globalWriteErrorToDebugWindow Then
1430 Debug.Print strMethodName & gstrErrorDescription & "(" &
glngErrorNumber & ") [" & gstrErrorSource & "]<" & glngErrorLine & "> "
1440 End If
1450 End If
End Function
