How to determine if file has been successfully transfered via ftp

DevelopV · Aug 22, 2013

I transfer files to an Internet server using the code below. The transferred file is imported into a MySql database, and sometimes records are missing. I need to solve this!
I want to begin the troubleshooting by ensuring that the file is transferred 100%.
How do I do this?

Code:

Private Sub cmdUploadFiles_Click()

Dim FileToCopy As String
Dim FileToCopyFrom As String
Dim FileToCopyTo As String

With New FTPClient
    .ServerName = pubInternetDomainName
    .UserName = pubInternetFTPUserName
    .Password = pubInternetFTPPassword
    .RemoteDir = pubWebOrderUploadDataToInternetFolder & "/"
    .TransferType = "ASC"
    .OpenFTP
    .OpenServer
    For varItem = 0 To Me.lstAvialableFilesForUpload.ListCount - 1
        FileToCopy = Me.lstAvialableFilesForUpload.Column(0, varItem)
        FileToCopyFrom = pubWebOrderUploadDataFromLocalFolder & "\"
        .LocalFile = FileToCopyFrom & FileToCopy
        .RemoteDir = pubWebOrderUploadDataToInternetFolder & "/"
        .RemoteFile = FileToCopy
        .ftp_PutFile
    Next
    .CloseServer
    .CloseFTP
End With

End Sub

FTP Client code:

Code:

Option Compare Database
Option Explicit
'
''''''''''''''''
' FTPClient                   '
''''''''''''''''
' Author Stuart McCall        '
' [email="100620.2641@compuserve.com"]100620.2641@compuserve.com[/email]  '
' [email="smccall@smsb.demon.co.UK"]smccall@smsb.demon.co.UK[/email]    '
' [url="[URL unfurl="true"]http://www.smsb.demon.co.UK/"[/URL]][URL unfurl="true"]http://www.smsb.demon.co.UK[/URL][/url] ' < this site is offline :-(
''''''''''''''''
' 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 ftp_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 ftp_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 ftp_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 ftp_RaiseError errOpenCon
    
End Sub

Public Sub CloseServer()
'Terminate connection to server

    If m_hCon Then InternetCloseHandle m_hCon
    m_hCon = 0
    
End Sub

Public Sub ftp_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 ftp_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 ftp_RaiseError errNoRemoteFile
    If Len(m_LocalFile) = 0 Then ftp_RaiseError errNoLocalFile
    If Len(m_TransferType) = 0 Then Me.TransferType = "BINARY"
    '
    'Change directory on server
    Me.ftp_SetDir m_RemoteDir
    '
    If ftpGetFile(m_hCon, m_RemoteFile, m_LocalFile, False, _
      INTERNET_FLAG_RELOAD, m_TransferType, 0) = False Then
        ftp_RaiseError errGetFile
    End If
        
End Sub

Public Sub ftp_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 ftp_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 ftp_RaiseError errNoRemoteFile
    If Len(m_LocalFile) = 0 Then ftp_RaiseError errNoLocalFile
    If Len(m_TransferType) = 0 Then Me.TransferType = "BINARY"
    '
    'Change directory on server
    Me.ftp_SetDir m_RemoteDir
    '
    If ftpPutFile(m_hCon, m_LocalFile, m_RemoteFile, m_TransferType, 0) = False Then
        ftp_RaiseError errPutFile
    End If
        
End Sub

Public Sub ftp_DelFile(Optional pRemoteDir, Optional pRemoteFile)
'Delete a file on server

    'Bail out if server connection not established
    If m_hCon = 0 Then ftp_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 ftp_RaiseError errNoRemoteFile
    '
    'Change directory on server
    Me.ftp_SetDir m_RemoteDir
    '
    If FtpDeleteFile(m_hCon, m_RemoteFile) = False Then
        ftp_RaiseError errDelFile
    End If
        
End Sub

Public Sub ftp_RenFile(Optional pOldName, Optional pNewName)
'Rename a file on server

    'Bail out if server connection not established
    If m_hCon = 0 Then ftp_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 ftp_RaiseError errNoRemoteFile
    If Len(m_NewFileName) = 0 Then m_NewFileName = m_RemoteFile
    '
    'Change directory on server
    Me.ftp_SetDir m_RemoteDir
    '
    If FtpRenameFile(m_hCon, m_RemoteFile, m_NewFileName) = False Then
        ftp_RaiseError errRenFile
    End If
        
End Sub

Public Function ftp_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 ftp_RaiseError errNotConnected
    '
    BufLen = MAX_PATH
    Buffer = String(BufLen, 0)
    If FtpGetCurrentDirectory(m_hCon, Buffer, BufLen) = False Then
        ftp_RaiseError errGetDir
    End If
    ftp_GetDir = Left(Buffer, BufLen)
    
End Function

Public Sub ftp_SetDir(Optional pRemoteDir)
'Change current directory on server

    'Bail out if server connection not established
    If m_hCon = 0 Then ftp_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
        ftp_RaiseError errSetDir
    End If
        
End Sub

Public Sub ftp_CreateDir(Optional pRemoteDir)
'Create directory on server

    'Bail out if server connection not established
    If m_hCon = 0 Then ftp_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
        ftp_RaiseError errCreateDir
    End If
        
End Sub

Public Sub ftp_DelDir(Optional pRemoteDir)
'Delete directory on server

    'Bail out if server connection not established
    If m_hCon = 0 Then ftp_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
        ftp_RaiseError errDelDir
    End If
        
End Sub

Public Sub ftp_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 ftp_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.ftp_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
            ftp_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
                ftp_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 ftp_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.ftp_ClearFileNames
End Sub

''''''''''''''''
'Utility Routines
''''''''''''''''
Private Sub ftp_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 ftp_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
ftp_LastResponse = Left(Buffer, BufLen)
End If

End Function

strongm · Aug 23, 2013

If FTP were corrupting the file you'd not simply be missing records ...

And whilst FTP itself performs no error checking of the transmitted data stream, it uses TCP which by design provides reliable, ordered, error-checked delivery of a stream of octets. In other words, if the FTP transfer completes without error then the received file is an exact match of the transmitted file.

1DMF · Aug 23, 2013

you could use another routine to list the folder of where it was uploaded to and check it exists.

The following code is for getting a list of a directory on the FTP server. I use it to find out what is in a particular folder so I can then download the files.

Code:

Const MAX_PATH = 260
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const PassiveConnection As Boolean = True

Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Public 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

Function FTPList(ByVal HostName As String, ByVal Username As String, ByVal Password As String, ByVal sDir As String) As String()
    
    On Error GoTo Err_Function
    
    Dim pData As WIN32_FIND_DATA
    Dim hFind As Long, lRet As Long
    Dim hConnection, hOpen, hFile  As Long
    Dim sFiles() As String
    Dim sPath As String

    sPath = String(MAX_PATH, 0)
    
    ' Open Internet Connecion
    hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)
    
    ' Connect to FTP
    hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT, Username, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)

    ' Change Directory
    Call FtpSetCurrentDirectory(hConnection, sDir)

    ' get list of directory
    Call FtpGetCurrentDirectory(hConnection, sPath, Len(sPath))
    
    pData.cFileName = String(MAX_PATH, 0)
    
    'find the first file
    hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
    
    'if there are files
    If hFind <> 0 Then
    
        'set first file
        ReDim Preserve sFiles(0)
        sFiles(UBound(sFiles)) = 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
            ReDim Preserve sFiles(UBound(sFiles) + 1)
            'add additional files
            sFiles(UBound(sFiles)) = left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
        Loop
        
    End If

Exit_Function:

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)
FTPList = sFiles
Exit Function

Err_Function:
    MsgBox "Error in FTPList : " & err.Description
Resume Exit_Function
    
End Function

You could modify it to confirm a specific file exists.

That way as StrongM suggests, if it appears to upload OK and you check it does exist, it would indicate the file processing routine to import the file to the MySQL DB is likely to be where the problem lies.

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

How to determine if file has been successfully transfered via ftp

DevelopV

Technical User

strongm

MIS

1DMF

Programmer

Similar threads

Part and Inventory Search

Sponsor