Hi Wayne,
This code won't compile. It croaks on: booUploadSucceeded = False
with "variable not defined". There are other examples of the same
thing in other procs. Any clues?
Thanks,
-- LW
Public Sub PutFile(Optional pRemoteDir, Optional pRemoteFile, _
Optional pLocalFile, Optional pTransferType)
'Transmit a file to server
'pTransferType accepts "ASCII" or "BINARY"
'Bail out if server connection not established
If m_hCon = 0 Then RaiseError errNotConnected
'
'Handle optional parameters
If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
If Not IsMissing(pRemoteFile) Then m_RemoteFile = pRemoteFile
If Not IsMissing(pLocalFile) Then m_LocalFile = pLocalFile
If Not IsMissing(pTransferType) Then Me.TransferType =
pTransferType
'
'Handle empty properties
If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
If Len(m_RemoteFile) = 0 Then RaiseError errNoRemoteFile
If Len(m_LocalFile) = 0 Then RaiseError errNoLocalFile
If Len(m_TransferType) = 0 Then Me.TransferType = "BINARY"
'
'Change directory on server
Me.SetDir m_RemoteDir
'
If FtpPutFile(m_hCon, m_LocalFile, m_RemoteFile, m_TransferType,
0) = False Then
'RaiseError errPutFile
booUploadSucceeded = False
Else
booUploadSucceeded = True
End If
End Sub
On Sun, 11 Dec 2005 06:44:08 GMT, Wayne Gillespie
<bestfit@NOhotmailSPAM.com.au> wrote:
[color=blue]
>On Sat, 10 Dec 2005 18:15:07 -0600, Lauren Wilson <nospam@none.com> wrote:
>[color=green]
>>Does anyone know if it is possible to capture FTP responses to various
>>FTP commands when managing an FTP session from a VBA procedure?
>>
>>For example, if we try to login to an FTP server and the login info is
>>incorrect, FTP replies with a message to that effect. I need to
>>capture those kinds of responses and advise the user of an Access app
>>what is happening.
>>
>>Thanks for all responses.[/color]
>
>I have used this with good effect over the years.
>Post the following code into a new CLASS module.
>
>'
>'''''''''''''''''''''''''''''''
>' FTPClient '
>'''''''''''''''''''''''''''''''
>' Author Stuart McCall '
>'
100620.2641@compuserve.com '
>'
smccall@smsb.demon.co.uk '
>'
http://www.smsb.demon.co.uk '
>'''''''''''''''''''''''''''''''
>' July 1998 '
>'''''''''''''''''''''''''''''''
>'
>'''''''''''''''''''''''''''''''
>'Member Variables
>'''''''''''''''''''''''''''''''
>Private m_ProxyName As String
>Private m_RemoteDir As String
>Private m_RemoteFile As String
>Private m_NewFileName As String
>Private m_LocalFile As String
>Private m_ServerName As String
>Private m_UserName As String
>Private m_Password As String
>Private m_TransferType As Long
>Private m_FileSpec As String
>'
>'''''''''''''''''''''''''''''''
>'Collections
>'''''''''''''''''''''''''''''''
>Public FileNames As New Collection
>'
>'''''''''''''''''''''''''''''''
>'Private Variables
>'''''''''''''''''''''''''''''''
>Private m_hFTP As Long 'Handle to the FTP session
>Private m_hCon As Long 'Handle to the server connection
>'
>'''''''''''''''''''''''''''''''
>'Private Constants
>'''''''''''''''''''''''''''''''
>Private Const mc_AGENTNAME = "FTP Class"
>'
>'''''''''''''''''''''''''''''''
>'Error values (See the RaiseError routine)
>'''''''''''''''''''''''''''''''
>Private Const errOpenFTP As String = "1;Call to InternetOpen failed."
>Private Const errOpenCon As String = "2;Call to InternetConnect failed."
>Private Const errGetFile As String = "3;Call to FtpGetFile failed."
>Private Const errPutFile As String = "4;Call to FtpPutFile failed."
>Private Const errDelFile As String = "5;Call to FtpDeleteFile failed."
>Private Const errRenFile As String = "6;Call to FtpRenameFile failed."
>Private Const errGetDir As String = "7;Call to FtpGetCurrentDirectory failed."
>Private Const errSetDir As String = "8;Call to FtpSetCurrentDirectory failed."
>Private Const errCreateDir As String = "9;Call to FtpCreateDirectory failed."
>Private Const errFindFirst As String = "10;Call to FtpFindFirstFile failed."
>Private Const errFindNext As String = "11;Call to InternetFindNextFile failed."
>Private Const errDelDir As String = "12;Call to FtpRemoveDirectory failed."
>Private Const errNotOpen As String = "13;FTP session not open. Call OpenFTP first."
>Private Const errNotConnected As String = "14;Not connected to a server. Call OpenServer first."
>Private Const errNoServer As String = "15;No Server Name specified."
>Private Const errNoLocalFile As String = "16;No Local File specified."
>Private Const errNoRemoteFile As String = "17;No Remote File specified."
>'
>'''''''''''''''''''''''''''''''
>'API Declarations
>'''''''''''''''''''''''''''''''
>Private Const MAX_PATH = &H104
>'
>Private Const INTERNET_INVALID_PORT_NUMBER = &H0
>Private Const INTERNET_SERVICE_FTP = &H1
>Private Const INTERNET_OPEN_TYPE_DIRECT = &H1
>Private Const INTERNET_OPEN_TYPE_PROXY = &H3
>Private Const INTERNET_FLAG_RELOAD = &H80000000
>Private Const INTERNET_FLAG_PASSIVE = &H8000000
>'
>Private Const FTP_TRANSFER_TYPE_ASCII = &H0
>Private Const FTP_TRANSFER_TYPE_BINARY = &H1
>'
>Private Const NO_ERROR = &H0
>Private Const ERROR_NO_MORE_FILES = &H12
>Private Const ERROR_INTERNET_EXTENDED_ERROR = &H2EE3
>'
>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
>'
>Private Declare Function FtpCreateDirectory Lib "wininet.dll" _
> Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
>Private Declare Function FtpDeleteFile Lib "wininet.dll" _
> Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
>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 FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
> (ByVal hFtpSession As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
>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 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 FtpRemoveDirectory Lib "wininet.dll" _
> Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
>Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" _
> (ByVal hFtpSession As Long, ByVal lpszExistFile As String, ByVal lpszNewFile As String) As Boolean
>Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
> (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
>Private Declare Function InternetCloseHandle Lib "wininet.dll" _
> (ByVal hInet As Long) As Integer
>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 InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
> (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
>Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" _
> (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
>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
>
>'''''''''''''''''''''''''''''''
>'Properties
>'''''''''''''''''''''''''''''''
>Public Property Get ProxyName() As String
> ProxyName = m_ProxyName
>End Property
>Public Property Let ProxyName(NewData As String)
> m_ProxyName = NewData
>End Property
>
>Public Property Get RemoteDir() As String
> RemoteDir = m_RemoteDir
>End Property
>Public Property Let RemoteDir(NewData As String)
> m_RemoteDir = NewData
>End Property
>
>Public Property Get RemoteFile() As String
> RemoteFile = m_RemoteFile
>End Property
>Public Property Let RemoteFile(NewData As String)
> m_RemoteFile = NewData
>End Property
>
>Public Property Get LocalFile() As String
> LocalFile = m_LocalFile
>End Property
>Public Property Let LocalFile(NewData As String)
> m_LocalFile = NewData
>End Property
>
>Public Property Let NewFileName(NewData As String)
> m_NewFileName = NewData
>End Property
>
>Public Property Get ServerName() As String
> ServerName = m_ServerName
>End Property
>Public Property Let ServerName(NewData As String)
> m_ServerName = NewData
>End Property
>
>Public Property Get UserName() As String
> UserName = m_UserName
>End Property
>Public Property Let UserName(NewData As String)
> m_UserName = NewData
>End Property
>
>Public Property Get Password() As String
> Password = m_Password
>End Property
>Public Property Let Password(NewData As String)
> m_Password = NewData
>End Property
>
>Public Property Get TransferType() As String
> TransferType = IIf(m_TransferType = FTP_TRANSFER_TYPE_BINARY, "BINARY", "ASCII")
>End Property
>Public Property Let TransferType(NewData As String)
> m_TransferType = IIf(UCase(Left(NewData, 3)) = "BIN", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII)
>End Property
>
>Public Property Get FileSpec() As String
> FileSpec = m_FileSpec
>End Property
>Public Property Let FileSpec(NewData As String)
> m_FileSpec = NewData
>End Property
>
>'''''''''''''''''''''''''''''''
>'Methods
>'''''''''''''''''''''''''''''''
>Public Sub OpenFTP(Optional pProxyName)
>'Initiate FTP session
>
> 'Handle optional parameters
> If Not IsMissing(pProxyName) Then m_ProxyName = pProxyName
> '
> If Len(m_ProxyName) Then
> m_hFTP = InternetOpen(mc_AGENTNAME, INTERNET_OPEN_TYPE_PROXY, _
> m_ProxyName, vbNullString, 0)
> Else
> m_hFTP = InternetOpen(mc_AGENTNAME, INTERNET_OPEN_TYPE_DIRECT, _
> vbNullString, vbNullString, 0)
> End If
> If m_hFTP = 0 Then RaiseError errOpenFTP
>
>End Sub
>
>Public Sub CloseFTP()
>'Terminate FTP session
>
> If m_hCon Then Me.CloseServer
> If m_hFTP Then InternetCloseHandle m_hFTP
> m_hCon = 0
> m_hFTP = 0
>
>End Sub
>
>Public Sub OpenServer(Optional pServerName, Optional pUserName, Optional pPassword)
>'Establish connection to server
>
> 'If FTP session not initiated
> If m_hFTP = 0 Then RaiseError errNotOpen
> '
> 'Handle optional parameters
> If Not IsMissing(pServerName) Then m_ServerName = pServerName
> If Not IsMissing(pUserName) Then m_UserName = pUserName
> If Not IsMissing(pPassword) Then m_Password = pPassword
> '
> 'Handle empty properties
> If Len(m_ServerName) = 0 Then RaiseError errNoServer
> '
> 'The following are translated to:
> ' UserName: Anonymous
> ' Password: default email address
> 'by the API, if nulls passed
> If Len(m_UserName) = 0 Then m_UserName = vbNullString
> If Len(m_Password) = 0 Then m_Password = vbNullString
> '
> m_hCon = InternetConnect(m_hFTP, m_ServerName, INTERNET_INVALID_PORT_NUMBER, _
> m_UserName, m_Password, INTERNET_SERVICE_FTP, _
> INTERNET_FLAG_PASSIVE, 0)
> 'If m_hCon = 0 Then RaiseError errOpenCon
> If m_hCon = 0 Then
> booIsConnected = False
> Exit Sub
> Else
> booIsConnected = True
> End If
>End Sub
>
>Public Sub CloseServer()
>'Terminate connection to server
>
> If m_hCon Then InternetCloseHandle m_hCon
> m_hCon = 0
>
>End Sub
>
>Public Sub GetFile(Optional pRemoteDir, Optional pRemoteFile, _
> Optional pLocalFile, Optional pTransferType)
>'Retrieve a file from server
>'pTransferType accepts "ASCII" or "BINARY"
>
> 'Bail out if server connection not established
> If m_hCon = 0 Then RaiseError errNotConnected
> '
> 'Handle optional parameters
> If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
> If Not IsMissing(pRemoteFile) Then m_RemoteFile = pRemoteFile
> If Not IsMissing(pLocalFile) Then m_LocalFile = pLocalFile
> If Not IsMissing(pTransferType) Then Me.TransferType = pTransferType
> '
> 'Handle empty properties
> If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
> If Len(m_RemoteFile) = 0 Then RaiseError errNoRemoteFile
> If Len(m_LocalFile) = 0 Then RaiseError errNoLocalFile
> If Len(m_TransferType) = 0 Then Me.TransferType = "BINARY"
> '
> 'Change directory on server
> Me.SetDir m_RemoteDir
> '
> If FtpGetFile(m_hCon, m_RemoteFile, m_LocalFile, False, _
> INTERNET_FLAG_RELOAD, m_TransferType, 0) = False Then
> 'RaiseError errGetFile
> booDownloadSucceeded = False
> Else
> booDownloadSucceeded = True
> End If
>
>End Sub
>
>Public Sub PutFile(Optional pRemoteDir, Optional pRemoteFile, _
> Optional pLocalFile, Optional pTransferType)
>'Transmit a file to server
>'pTransferType accepts "ASCII" or "BINARY"
>
> 'Bail out if server connection not established
> If m_hCon = 0 Then RaiseError errNotConnected
> '
> 'Handle optional parameters
> If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
> If Not IsMissing(pRemoteFile) Then m_RemoteFile = pRemoteFile
> If Not IsMissing(pLocalFile) Then m_LocalFile = pLocalFile
> If Not IsMissing(pTransferType) Then Me.TransferType = pTransferType
> '
> 'Handle empty properties
> If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
> If Len(m_RemoteFile) = 0 Then RaiseError errNoRemoteFile
> If Len(m_LocalFile) = 0 Then RaiseError errNoLocalFile
> If Len(m_TransferType) = 0 Then Me.TransferType = "BINARY"
> '
> 'Change directory on server
> Me.SetDir m_RemoteDir
> '
> If FtpPutFile(m_hCon, m_LocalFile, m_RemoteFile, m_TransferType, 0) = False Then
> 'RaiseError errPutFile
> booUploadSucceeded = False
> Else
> booUploadSucceeded = True
> End If
>
>End Sub
>
>Public Sub DelFile(Optional pRemoteDir, Optional pRemoteFile)
>'Delete a file on server
>
> 'Bail out if server connection not established
> If m_hCon = 0 Then RaiseError errNotConnected
> '
> 'Handle optional parameters
> If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
> If Not IsMissing(pRemoteFile) Then m_RemoteFile = pRemoteFile
> '
> 'Handle empty properties
> If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
> If Len(m_RemoteFile) = 0 Then RaiseError errNoRemoteFile
> '
> 'Change directory on server
> Me.SetDir m_RemoteDir
> '
> If FtpDeleteFile(m_hCon, m_RemoteFile) = False Then
> 'RaiseError errDelFile
> booDownloadSucceeded = False
> End If
>
>End Sub
>
>Public Sub RenFile(Optional pOldName, Optional pNewName)
>'Rename a file on server
>
> 'Bail out if server connection not established
> If m_hCon = 0 Then RaiseError errNotConnected
> '
> 'Handle optional parameters
> If Not IsMissing(pOldName) Then m_RemoteFile = pOldName
> If Not IsMissing(pNewName) Then m_NewFileName = pNewName
> '
> 'Handle empty properties
> If Len(m_RemoteFile) = 0 Then RaiseError errNoRemoteFile
> If Len(m_NewFileName) = 0 Then m_NewFileName = m_RemoteFile
> '
> 'Change directory on server
> Me.SetDir m_RemoteDir
> '
> If FtpRenameFile(m_hCon, m_RemoteFile, m_NewFileName) = False Then
> RaiseError errRenFile
> End If
>
>End Sub
>
>Public Function GetDir() As String
>'Determine current directory on server
>
> Dim Buffer As String
> Dim BufLen As Long
> '
> 'Bail out if server connection not established
> If m_hCon = 0 Then RaiseError errNotConnected
> '
> BufLen = MAX_PATH
> Buffer = String(BufLen, 0)
> If FtpGetCurrentDirectory(m_hCon, Buffer, BufLen) = False Then
> RaiseError errGetDir
> End If
> GetDir = Left(Buffer, BufLen)
>
>End Function
>
>Public Sub SetDir(Optional pRemoteDir)
>'Change current directory on server
>
> 'Bail out if server connection not established
> If m_hCon = 0 Then RaiseError errNotConnected
> '
> 'Handle optional parameters
> If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
> '
> 'Handle empty properties
> If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
> '
> If FtpSetCurrentDirectory(m_hCon, m_RemoteDir) = False Then
> RaiseError errSetDir
> End If
>
>End Sub
>
>Public Sub CreateDir(Optional pRemoteDir)
>'Create directory on server
>
> 'Bail out if server connection not established
> If m_hCon = 0 Then RaiseError errNotConnected
> '
> 'Handle optional parameters
> If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
> '
> 'Handle empty properties
> If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
> '
> If FtpCreateDirectory(m_hCon, m_RemoteDir) = False Then
> RaiseError errCreateDir
> End If
>
>End Sub
>
>Public Sub DelDir(Optional pRemoteDir)
>'Delete directory on server
>
> 'Bail out if server connection not established
> If m_hCon = 0 Then RaiseError errNotConnected
> '
> 'Handle optional parameters
> If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
> '
> 'Handle empty properties
> If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
> '
> If FtpRemoveDirectory(m_hCon, m_RemoteDir) = False Then
> RaiseError errDelDir
> End If
>
>End Sub
>
>Public Sub GetFileNames(Optional pRemoteDir, Optional pFileSpec)
>'Fill the FileNames collection with list
>'of files matching pFileSpec from server's
>'current directory
>
> Dim hFind As Long
> Dim LastErr As Long
> Dim fData As WIN32_FIND_DATA
> '
> 'Bail out if server connection not established
> If m_hCon = 0 Then RaiseError errNotConnected
> '
> 'Handle optional parameters
> If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
> If Not IsMissing(pFileSpec) Then m_FileSpec = pFileSpec
> '
> 'Handle empty properties
> If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
> If Len(m_FileSpec) = 0 Then m_FileSpec = "*.*"
> '
> 'Change directory on server
> Me.SetDir m_RemoteDir
> '
> 'Find first file matching FileSpec
> fData.cFileName = String(MAX_PATH, 0)
> 'Obtain search handle if successful
> hFind = FtpFindFirstFile(m_hCon, m_FileSpec, fData, 0, 0)
> LastErr = Err.LastDllError
> If hFind = 0 Then
> 'Bail out if reported error isn't end-of-file-list
> If LastErr <> ERROR_NO_MORE_FILES Then
> RaiseError errFindFirst
> End If
> 'Must be no more files
> Exit Sub
> End If
> '
> 'Reset variable for next call
> LastErr = NO_ERROR
> '
> 'Add filename to the collection
> FileNames.Add Left(fData.cFileName, _
> InStr(1, fData.cFileName, vbNullChar, vbBinaryCompare) - 1)
> Do
> 'Find next file matching FileSpec
> fData.cFileName = String(MAX_PATH, 0)
> If InternetFindNextFile(hFind, fData) = False Then
> LastErr = Err.LastDllError
> If LastErr = ERROR_NO_MORE_FILES Then
> 'Bail out if no more files
> Exit Do
> Else
> 'Must be a 'real' error
> InternetCloseHandle hFind
> RaiseError errFindNext
> End If
> Else
> 'Add filename to the collection
> FileNames.Add Left(fData.cFileName, _
> InStr(1, fData.cFileName, vbNullChar, vbBinaryCompare) - 1)
> End If
> Loop
> '
> 'Release the search handle
> InternetCloseHandle hFind
>
>End Sub
>
>Public Sub ClearFileNames()
>'Clear contents of FileNames collection
>
> Dim itm As Long
> '
> With FileNames
> For itm = 1 To .Count
> .Remove 1
> Next
> End With
>
>End Sub
>
>Private Sub Class_Initialize()
>'Set property defaults
>
> m_RemoteDir = "."
> m_RemoteFile = vbNullString
> m_LocalFile = vbNullString
> m_NewFileName = vbNullString
> m_UserName = vbNullString
> m_Password = vbNullString
> m_ProxyName = vbNullString
> m_ServerName = vbNullString
> m_TransferType = FTP_TRANSFER_TYPE_BINARY
>
>End Sub
>
>Private Sub Class_Terminate()
> Me.ClearFileNames
>End Sub
>
>'''''''''''''''''''''''''''''''
>'Utility Routines
>'''''''''''''''''''''''''''''''
>Private Sub RaiseError(ByVal ErrValue As String)
>'Extracts the value to be added to the vbObjectError
>'constant from the 1st section of ErrValue, and
>'the error description from the 2nd section
>'(Sections delimited with ';')
>'Appends the last internet response string
>
> Dim ptr As Integer
> Dim InetErr As Long
> '
> 'If we have a session handle, destroy the session
> If m_hCon <> 0 Or m_hFTP <> 0 Then Me.CloseFTP
> '
> ptr = InStr(1, ErrValue, ";")
> InetErr = Err.LastDllError
> 'Err.Raise vbObjectError + Val(Left$(ErrValue, ptr - 1)), _
> "FTP Class", _
> Mid$(ErrValue, ptr + 1) & ". (OS error code = " & InetErr & ")" & _
> vbCrLf & "Internet Response: " & LastResponse(InetErr)
>
>End Sub
>
>Private Function LastResponse(ByVal ErrNum As Long) As String
>'Obtains the last response string issued by server
>
> Dim Buffer As String
> Dim BufLen As Long
> '
> If ErrNum = ERROR_INTERNET_EXTENDED_ERROR Then
> ErrNum = 0
> InternetGetLastResponseInfo ErrNum, vbNullString, BufLen
> Buffer = String(BufLen + 1, 0)
> InternetGetLastResponseInfo ErrNum, Buffer, BufLen
> LastResponse = Left(Buffer, BufLen)
> End If
>
>End Function
>
>
>Wayne Gillespie
>Gosford NSW Australia[/color]
