I've got this working now by separately querying the file size before
download or after upload. Here is my FTP module, mostly cribbed from
the interweb. FTP_Get_File and FTP_Put_File are my generic functions,
at the end. One minor concern I have is that I'm not calling any
function to close the file, but that shouldn't be a problem once the
connection is closed.
Option Explicit
'//
'// Dedicated to my Friend Colo
'// Some of the code from
http://www.allapi.net
'// spec thanks to Joacim Andersson 29 July 2001
'// Amendments by Ivan F Moala 28 Sept 2002
'// Amendments by Phil Hibbs 2 Dec 2009
'//
Public Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_FLAG_PASSIVE = &H8000000 '// used for FTP
connections
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0 '// use registry
configuration
Private Const INTERNET_OPEN_TYPE_DIRECT = 1 '// direct to net
Private Const INTERNET_OPEN_TYPE_PROXY = 3 '// via named
proxy
Private Const _
INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 '// prevent
using java/script/INS
Private Const MAX_PATH = 260
Private Const INTERNET_INVALID_PORT_NUMBER = 0 '// use the protocol-
specific default
Private Const INTERNET_DEFAULT_FTP_PORT = 21 '// default for FTP
servers
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70 '// " "
gopher "
Private Const INTERNET_DEFAULT_HTTP_PORT = 80 '// " "
HTTP "
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443 '// " "
HTTPS "
Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080 '// default for SOCKS
firewall servers.
Private Const GENERIC_READ = &H80000000
Private Const MAXDWORD As Double = (2 ^ 32) - 1
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Declare Function InternetCloseHandle Lib "wininet.dll" ( _
ByVal hInet As Long) As Integer
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
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
Declare Function FtpSetCurrentDirectory Lib "wininet.dll" _
Alias "FtpSetCurrentDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Declare Function FtpGetCurrentDirectory Lib "wininet.dll" _
Alias "FtpGetCurrentDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszCurrentDirectory As String, _
lpdwCurrentDirectory As Long) As Long
Declare Function FtpCreateDirectory Lib "wininet.dll" _
Alias "FtpCreateDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Declare Function FtpRemoveDirectory Lib "wininet.dll" _
Alias "FtpRemoveDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Declare Function FtpRenameFile Lib "wininet.dll" _
Alias "FtpRenameFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszExisting As String, _
ByVal lpszNew As String) As Boolean
Declare Function FtpGetFile Lib "wininet.dll" _
Alias "FtpGetFileA" ( _
ByVal hConnect As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByRef dwContext As Long) As Boolean
Declare Function FtpGetFileSize Lib "wininet.dll" ( _
ByVal hFile As Long, _
ByRef FileSizeHigh As Long) As Long
'Declare Function FtpGetFileSize Lib "wininet.dll" _
' Alias "FtpGetFileSizeA" ( _
' ByVal hFile As Long, _
' ByRef lpdwFileSizeHigh As Long) As Long
Declare Function FtpOpenFile Lib "wininet.dll" _
Alias "FtpOpenFileA" ( _
ByVal hConnect As Long, _
ByVal lpszFileName As String, _
ByVal dwAccess As Long, _
ByVal dwFlags As Long, _
ByRef dwContext As Long) As Long
Declare Function FtpPutFile Lib "wininet.dll" _
Alias "FtpPutFileA" ( _
ByVal hConnect As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszNewRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
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
Declare Function InternetFindNextFile Lib "wininet.dll" _
Alias "InternetFindNextFileA" ( _
ByVal hFind As Long, _
lpvFindData As WIN32_FIND_DATA) As Long
Private Const PassiveConnection As Boolean = True
Private Const ERROR_NO_MORE_FILES = 18&
Public Sub EnumFiles(hConnection As Long)
Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
'// set the graphics mode to persistent
'Me.AutoRedraw = True
'// create a buffer
pData.cFileName = String(MAX_PATH, 0)
'// find the first file
hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
'// if there's no file, then exit sub
If hFind = 0 Then Exit Sub
'// show the filename
MsgBox Left(pData.cFileName, InStr(1, pData.cFileName, _
String(1, 0), vbBinaryCompare) - 1)
Do
'// create a buffer
pData.cFileName = String(MAX_PATH, 0)
'// find the next file
lRet = InternetFindNextFile(hFind, pData)
'// if there's no next file, exit do
If lRet = 0 Then Exit Do
'// show the filename
MsgBox Left(pData.cFileName, InStr(1, pData.cFileName, _
String(1, 0), vbBinaryCompare) - 1)
Loop
'// close the search handle
InternetCloseHandle hFind
End Sub
Sub ShowError()
Dim lErr As Long, sErr As String, lenBuf As Long
'// get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'// create a buffer
sErr = String(lenBuf, 0)
'// retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'// show the last response info
MsgBox "Error " & CStr(lErr) & ": " & sErr, vbOKOnly + vbCritical
End Sub
Function FTP_Put_File(Server As String, _
Logon As String, _
Password As String, _
Source As String, _
Target As String, _
Mode As Long) _
As Long
Dim hConnection As Long, hOpen As Long, hFile As Long, sOrgPath
As String
Dim lLowSize As Long, lHighSize As Long, lSize As Long
'// open an internet connection
hOpen = InternetOpen("Excel Spreadsheet Source Management", _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0)
'// connect to the FTP server
hConnection = InternetConnect(hOpen, _
Server, _
INTERNET_DEFAULT_FTP_PORT, _
Logon, _
Password, _
INTERNET_SERVICE_FTP, _
IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), _
0)
'// upload the file
FTP_Put_File = FtpPutFile(hConnection, Source, Target, Mode, 0)
If FTP_Put_File Then
'// check the file size
hFile = FtpOpenFile(hConnection, Target, GENERIC_READ, Mode,
0)
lLowSize = FtpGetFileSize(hFile, lHighSize)
lSize = lLowSize
FTP_Put_File = lSize
Else
FTP_Put_File = -1
End If
'// close the FTP connection
InternetCloseHandle hConnection
'// close the internet connection
InternetCloseHandle hOpen
End Function
Function FTP_Get_File(Server As String, _
Logon As String, _
Password As String, _
Source As String, _
Target As String, _
Mode As Long) _
As Long
Dim hConnection As Long, hOpen As Long, hFile As Long, sOrgPath
As String
Dim lLowSize As Long, lHighSize As Long, lSize As Long
'// open an internet connection
hOpen = InternetOpen("Excel Spreadsheet Source Management", _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0)
'// connect to the FTP server
hConnection = InternetConnect(hOpen, _
Server, _
INTERNET_DEFAULT_FTP_PORT, _
Logon, _
Password, _
INTERNET_SERVICE_FTP, _
IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), _
0)
'// check the file size
hFile = FtpOpenFile(hConnection, Source, GENERIC_READ, Mode, 0)
lLowSize = FtpGetFileSize(hFile, lHighSize)
lSize = lLowSize
'// upload the file
FTP_Get_File = FtpGetFile(hConnection, Source, Target, Mode, 0)
'// close the FTP connection
InternetCloseHandle hConnection
'// close the internet connection
InternetCloseHandle hOpen
If FTP_Get_File Then
FTP_Get_File = lSize
Else
FTP_Get_File = -1
End If
End Function
