Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I'm using the wininet.dll FtpGetFile and FtpPutFile functions from
VBA, but they just return a boolean success-or-fail. Does anyone know how to get more info about the transfer, e.g. why it failed or how many bytes were transferred? Phil Hibbs. |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
File Size With Macros Has Increased From Its Origina Size | Excel Discussion (Misc queries) | |||
Size Matters - minimizing file size | Excel Programming | |||
how to set sheet size to reduce file size | Excel Discussion (Misc queries) | |||
VBA WinInet Code Crashes Excel | Excel Programming | |||
How to get the size of the excel file, a sheet size (in bytes)? | Excel Programming |