asked on

MS Access ftp upload problem

I'm suddenly having problems with some code I've been using successfully for some time without problems.

I'm uploading a local text file to web server. Everything appears to be ok. The file is created on the remote server, but it's empty? So it's creating the file but not transferring the data to it.

Anyone got any ideas?

This is the sub used to trigger it

Private Sub Command9_Click()

   On Error GoTo Command9_Click_Error
Dim oFtp As bzFtp
Set oFtp = New bzFtp
Dim cLocalName As String
Dim cLocalName2 As String
Dim cRemoteName As String
Dim fileUp As Boolean
Dim thisConnection As Boolean
fileUp = False
thisConnection = False
thisConnection = oFtp.Connect("www.xxxxxxx.co.uk", "xxxxxx", "xxxxxx")
If oFtp.IsConnected Then

'upload data files
   cLocalName = "M:\ClientPortal\propertydata.txt"
   cRemoteName = "/clientdocs/propertydata.txt"
   fileUp = oFtp.PutFile(cLocalName, cRemoteName)
 End If
oFtp.Disconnect
   
   On Error GoTo 0
   Exit Sub

Command9_Click_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Command9_Click of VBA Document Form_frmExportData"
End Sub

Open in new window

And this the module

Option Compare Database
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Class for FTP access using Win32 API
'
'   Author: Bogdan Zamfir (ams@zappmobile.ro)
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Constands used by Wininet API calls
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''

' constants used for InternetOpen function, dwAccessType param
Const INTERNET_OPEN_TYPE_PRECONFIG = 0                     ' use registry configuration
Const INTERNET_OPEN_TYPE_DIRECT = 1                        ' direct to net
Const INTERNET_OPEN_TYPE_PROXY = 3                         ' via named proxy
Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4   ' prevent using java/script/INS

' constants used for InternetOpen function, dwFlags param
Const INTERNET_FLAG_ASYNC = &H10000000
Const INTERNET_FLAG_PASSIVE = &H8000000

' constants used for InternetConnect function, nServerPort param
Const INTERNET_INVALID_PORT_NUMBER = 0
Const INTERNET_DEFAULT_FTP_PORT = 21

' constants used for InternetConnect function, dwService param
Const INTERNET_SERVICE_URL = 0
Const INTERNET_SERVICE_FTP = 1

' constants used for FTP File transfer type
Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2

Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1

' constants used by FindFirst / Next file enumeration functions
Const F_ATTR_ARCHIVE = &H20
Const F_ATTR_DIRECTORY = &H10
Const F_ATTR_HIDDEN = &H2
Const F_ATTR_NORMAL = &H80
Const F_ATTR_READONLY = &H1
Const F_ATTR_SYSTEM = &H4
Const F_ATTR_TEMPORARY = &H100

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

' WIN32_FIND_DATA structure - used for FTPFindFirst / InternetFindNext
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 Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type


' private variables, used internal by FTP API functions
Dim nInetHND As Long        ' handle for opening Internet access session
Dim nFtpHND As Long         ' handle for FTP protocol session

Dim cBuffer As String       ' buffer used by misc FTP API functions
Dim nBufferLen As Long      ' buffer length used by misc FTP API functions

Dim nLastErrorNr As Long
Dim cLastErrorMessage As String

Dim cPathSeparator As String    ' store path separator for ftp server. It can be either \ or /

Dim lPASV As Boolean            ' true if FTP access uses PASV mode

Dim nTransferType As Long       ' transfer type: ascii, binary, image
                                ' use RO properties TransferASCII, TransferBINARY, TransferIMAGE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   internal variables for FTP access
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public cServer As String         ' ftp server to connect to
Public cUserName As String       ' if empty, anonymous is used
Public cPassword As String
Public nPort As Integer          ' default port for FTP access

' FTP API functions declare
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 InternetClose Lib "wininet.dll" Alias "InternetCloseHandle" _
    (ByRef hInternet As Long) As Long

Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternet As Long, _
    ByVal lpszServerName As String, _
    ByVal nServerPort As Integer, _
    ByVal lpszUsername As String, _
    ByVal lpszPassword As String, _
    ByVal dwService As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

Private Declare Function FTPGetCurDir Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
    (ByVal hConnect As Long, _
    ByVal lpszCurrentDirectory As String, _
    lpdwCurrentDirectory As Long) As Long
    
Private Declare Function FTPSetCurDir Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hConnect As Long, _
    ByVal lpszDirectory As String) As Long
    
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hConnect As Long, _
    ByVal lpszSearchFile As String, _
    ByRef lpFindFileData As WIN32_FIND_DATA, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
    
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, ByRef lpvFindData As Any) As Long
    
Private Declare Function FileTimeToLocalFileTime Lib "kernel32.dll" _
    (ByRef lpFileTime As FILETIME, ByRef lpLocalFileTime As FILETIME) As Long
    
Private Declare Function FileTimeToSystemTime Lib "kernel32.dll" _
    (ByRef lpFileTime As FILETIME, ByRef lpSystemTime As SYSTEMTIME) As Long
    
Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" _
    (ByVal hConnect As Long, ByVal lpszDirectory As String) As Long
    
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" _
    (ByVal hConnect As Long, ByVal lpszDirectory As String) As Long

Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" _
    (ByVal hConnect As Long, ByVal lpszOldName As String, ByVal lpszNewName As String) As Long
    
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" _
    (ByVal hConnect As Long, ByVal lpszName As String) As Long

Private Declare Function FtpCommand Lib "wininet.dll" Alias "FtpCommandA" _
    (ByVal hConnect As Long, _
    ByVal fExpectResponse As Long, _
    ByVal dwFlags As Long, _
    ByVal lpszCommand As String, _
    ByVal dwContext As Long, _
    ByRef phFtpCommand As Long) As Long
    
Private 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 Long
    
Private 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, _
    ByVal dwContext As Long) As Long
    
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" _
    (ByRef lpdwError As Long, _
    ByVal lpszBuffer As String, _
    ByRef lpdwBufferLength As Long) As Long

' constant and function to retrive error message for error encountered during API calls

Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

Private Declare Function FormatMessage Lib "kernel32" Alias _
      "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _
      ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
      ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) _
      As Long
      
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Server name property. R/W when not connected, and R/O while connected
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Let Server(ByVal cServerName As String)
    If Not IsConnected Then
        cServer = cServerName
    Else
        nLastErrorNr = 10001
        cLastErrorMessage = "SERVER property is R/O when the FTP object is connected to FTP server"
    End If
End Property
      
Property Get Server() As String
    Server = cServer
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Username property. R/W when not connected, and R/O while connected
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Let username(ByVal cUN As String)
    If Not IsConnected Then
        cUserName = cUN
    Else
        nLastErrorNr = 10001
        cLastErrorMessage = "USERNAME property is R/O when the FTP object is connected to FTP server"
    End If
End Property

Property Get username() As String
    If cUserName = "" Then
        cUserName = "anonymous"
    End If
    username = cUserName
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Password property. R/W when not connected, and R/O while connected
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Let password(ByVal cPW As String)
    If Not IsConnected Then
        cPassword = cPW
    Else
        nLastErrorNr = 10001
        cLastErrorMessage = "PASSWORD property is R/O when the FTP object is connected to FTP server"
    End If
End Property

Property Get password() As String
    password = cPassword
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Username property. R/W when not connected, and R/O while connected
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Let Port(ByVal nP As Integer)
    If Not IsConnected Then
        nPort = nP
    Else
        nLastErrorNr = 10001
        cLastErrorMessage = "PORT property is R/O when the FTP object is connected to FTP server"
    End If
End Property

Property Get Port() As Integer
    If nPort = 0 Then
        nPort = 21      ' default FTP port
    End If
    Port = nPort
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   R/O properties used as constants for transfer type
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get TransferASCII() As Long
    TransferASCII = FTP_TRANSFER_TYPE_ASCII
End Property
      
Public Property Get TransferBINARY() As Long
    TransferBINARY = FTP_TRANSFER_TYPE_BINARY
End Property
      
Public Property Get TransferIMAGE() As Long
    TransferIMAGE = FTP_TRANSFER_TYPE_BINARY
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Property used for transfer type
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get TransferType() As Long
    TransferType = nTransferType
End Property

Public Property Let TransferType(ByVal nTransType As Long)
    nTransferType = nTransType
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Property used for transfer in PASV mode
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get PASV() As Boolean
    PASV = lPASV
End Property

Public Property Let PASV(ByVal lPV As Boolean)
    If Not IsConnected Then
        lPASV = lPV
    Else
        nLastErrorNr = 10001
        cLastErrorMessage = "PASV property is R/O when the FTP object is connected to FTP server"
    End If
End Property


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   return the message associated with an error number during an API call
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function MessageText(lCode As Long) As String
    Dim sRtrnCode As String
    Dim lRet As Long

    sRtrnCode = Space$(256)
    lRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, lCode, 0&, _
              sRtrnCode, 256&, 0&)
    If lRet > 0 Then
       MessageText = Left(sRtrnCode, lRet)
    End If

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   return the message returned by FTP server as response to last FTP operation
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetLastInternetMessage() As String
    Dim sRtrnCode As String, nRtrnCode As Long
    Dim lRet As Long

    sRtrnCode = Space$(1000)
    nRtrnCode = Len(sRtrnCode)
    If InternetGetLastResponseInfo(lRet, sRtrnCode, nRtrnCode) Then
       GetLastInternetMessage = Left(sRtrnCode, nRtrnCode)
    Else
       GetLastInternetMessage = ""
    End If

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   return the error number for last DLL error
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetLastError() As Long
    GetLastError = nLastErrorNr
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   return the error message for last DLL error
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetLastErrorMessage() As String
    GetLastErrorMessage = cLastErrorMessage
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   upload a file on a FTP server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function PutFile(ByVal cLocalName As String, Optional ByVal cRemoteName As String = "") As Boolean
    If cRemoteName = "" Then
        cRemoteName = cLocalName
    End If
    PutFile = FtpPutFile(nFtpHND, cLocalName, cRemoteName, Me.TransferType, 0)
    If Not PutFile Then
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
    End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   download a file on a FTP server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetFile(ByVal cRemoteName As String, Optional Overwrite As Boolean = False, Optional ByVal cLocalName As String = "") As Boolean
    If cLocalName = "" Then
        cLocalName = cRemoteName
    End If
    GetFile = FtpGetFile(nFtpHND, cRemoteName, cLocalName, Not Overwrite, F_ATTR_NORMAL, Me.TransferType, 0)
    If Not GetFile Then
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
    End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   delete a file on a FTP server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function DeleteFile(ByVal cName As String) As Boolean
    DeleteFile = FtpDeleteFile(nFtpHND, cName)
    If Not DeleteFile Then
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
    End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   rename a file on a FTP server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RenameFile(ByVal cOldName As String, ByVal cNewName As String) As Boolean
    RenameFile = FtpRenameFile(nFtpHND, cOldName, cNewName)
    If Not RenameFile Then
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
    End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   create a new directory on a FTP server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CreateDirectory(ByVal cDirName As String) As Boolean
    CreateDirectory = FtpCreateDirectory(nFtpHND, cDirName)
    If Not CreateDirectory Then
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
    End If
End Function
        
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   remove a new directory from a FTP server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RemoveDirectory(ByVal cDirName As String) As Boolean
    RemoveDirectory = FtpRemoveDirectory(nFtpHND, cDirName)
    If Not RemoveDirectory Then
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
    End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Close an internet communication session
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Disconnect()
        
    If nFtpHND > 0 Then
        ' if ftp session handle is non 0, first send command to ftp server to close session
        ' then release the handle in wininet api
        FtpCommand nFtpHND, False, FTP_TRANSFER_TYPE_ASCII, "quit", 0, 0
        InternetClose nFtpHND
        nFtpHND = 0
    End If
    If nInetHND > 0 Then
        InternetClose nInetHND
        nInetHND = 0
    End If
    cPathSeparator = ""
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Returns connected status of a FTP session
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function IsConnected() As Boolean
    IsConnected = (nFtpHND > 0)
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   return path separator for a ftp server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Get PathSeparator() As String
    PathSeparator = cPathSeparator
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Connect to a ftp server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Connect(Optional ByVal cServer As String, _
    Optional ByVal cUserName As String, _
    Optional ByVal cPass As String) As Boolean
    
    On Error GoTo Connect_Err
    Dim strErrMsg As String         'For Error Handling
    
    ' validate connection parameters
    If cServer <> "" Then
        Server = cServer
    End If
    
    If cUserName <> "" Then
        username = cUserName
    End If

    If cPass <> "" Then
        password = cPass
    End If
    
    If Server = "" Then
        nLastErrorNr = 10000
        cLastErrorMessage = "FTP Server name is missing"
        Connect = False
        GoTo Connect_Exit
    End If
        
    Dim cTempStr As String
    cTempStr = Chr(0)
    
    nInetHND = InternetOpen("Bogdan Zamfir's FTP application", INTERNET_OPEN_TYPE_PRECONFIG, cTempStr, cTempStr, 0)
    If nInetHND = 0 Then
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
        Connect = False
        GoTo Connect_Exit
    End If
    
    nFtpHND = InternetConnect(nInetHND, Server, Port, _
        username, password, INTERNET_SERVICE_FTP, IIf(PASV, INTERNET_FLAG_PASSIVE, 0), 0)
    If nFtpHND = 0 Then
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
        Connect = False
        GoTo Connect_Exit
    End If
    
    ' try to find path separator for ftp server
    Dim cPath As String
    If InStr(GetCurrentDirectory, "/") > 0 Then
        ' if / is found in path, it is path separator
        cPathSeparator = "/"
    Else
        cPathSeparator = "\"
    End If
    Connect = True

Connect_Exit:
    On Error Resume Next
    Exit Function

Connect_Err:
    Connect = False
    Select Case Err
        Case Else
            nLastErrorNr = Err.Number
            cLastErrorMessage = Err.Description
            Connect = False
            Resume Connect_Exit
    End Select
    
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   return current directory from a ftp server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetCurrentDirectory() As String
    Dim lRet As Boolean
    cBuffer = Space$(1000)
    nBufferLen = Len(cBuffer)
    lRet = FTPGetCurDir(nFtpHND, cBuffer, nBufferLen)
    If lRet Then
        GetCurrentDirectory = Left$(cBuffer, nBufferLen)
    Else
        GetCurrentDirectory = ""
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
    End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   change current directory for a ftp server
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function SetCurrentDirectory(ByVal cNewDir As String) As Boolean
    SetCurrentDirectory = FTPSetCurDir(nFtpHND, cNewDir)
    If Not SetCurrentDirectory Then
        nLastErrorNr = Err.LastDllError
        cLastErrorMessage = MessageText(nLastErrorNr)
    End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Get all files matching the skeleton
'   aFiles array has three columns: file name, attributes, filesize
'
'   cFlags param allow the following
'       D -> directory
'       R -> read-only
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function ListDirectory(ByRef oFiles As Collection, _
    Optional ByVal cSkel As String = "*", _
    Optional ByVal cFlags As String = "RD") As Boolean
    
    On Error GoTo GetFiles_Err
    Dim strErrMsg As String 'For Error Handling

    Dim WFD As WIN32_FIND_DATA
    Dim nFindHND As Long        ' handle for FindFile calls
    Dim lCont As Boolean, nFiles As Integer, lValidFile As Boolean, cAttrib As String
    Dim oFile As bzFile
    
    ' directory listing for some ftp servers does not contains .. entry (for parent folder)
    ' so I might need to add it by myself
    ' lIncludeParentFolder will be set to true if .. directory entry is found in directory listing
    ' to avoid adding it twice
    Dim lIncludeParentFolder As Boolean
    
    ' ftp session supports only one call of FTPFindFirstFile per session
    ' because of this, after enumerating files in a directory,
    ' we need to close ftp session and open it again
    ' we need to save current directory, in order to set it again after reconnection ftp session
    Dim cCurrentDir As String
    cCurrentDir = GetCurrentDirectory
    
    If cSkel = "" Then
        cSkel = "*"
    End If
    
    cFlags = UCase(cFlags)

    nFiles = 0
    nFindHND = FtpFindFirstFile(nFtpHND, cSkel, WFD, 0, 0)
    If nFindHND > 0 Then
        lCont = True
        Do While lCont
            lValidFile = False
            cAttrib = ""
            
            If VBA.InStr(cFlags, "R") > 0 _
                And ((WFD.dwFileAttributes And F_ATTR_READONLY) = F_ATTR_READONLY) Then

                lValidFile = lValidFile Or True
                cAttrib = cAttrib & "R"
            End If
            
            If VBA.InStr(cFlags, "D") > 0 _
                And ((WFD.dwFileAttributes And F_ATTR_DIRECTORY) = F_ATTR_DIRECTORY) Then
                    
                lValidFile = lValidFile Or True
                cAttrib = cAttrib & "D"
            End If
            
            If ((WFD.dwFileAttributes And F_ATTR_NORMAL) = F_ATTR_NORMAL) Then
                    
                lValidFile = lValidFile Or True
            End If
            
            If lValidFile Then
                nFiles = nFiles + 1
                If nFiles = 1 Then
                    Set oFiles = New Collection
                End If
                Set oFile = New bzFile
                oFile.FileName = StripNulls(WFD.cFileName)
                If oFile.FileName = ".." Then
                    lIncludeParentFolder = True
                End If
                oFile.Attributes = cAttrib
                oFile.Size = WFD.nFileSizeHigh * MAXDWORD + WFD.nFileSizeLow
                oFiles.Add oFile, oFile.FileName
            End If
            lCont = InternetFindNextFile(nFindHND, WFD)
        Loop
    End If
    
    ' if directory listing didn't returned .. entry, and we are not in the root folder, we add it
    If nFindHND > 0 And Not lIncludeParentFolder And (cCurrentDir <> "/" Or cCurrentDir <> "\") Then
        If nFiles = 0 Then
            Set oFiles = New Collection
        End If
        Set oFile = New bzFile
        oFile.FileName = ".."
        oFile.Attributes = "D"
        oFiles.Add oFile, oFile.FileName
    End If
    
    InternetClose nFindHND
       
    Disconnect
    If Connect Then
        SetCurrentDirectory cCurrentDir
        ListDirectory = True
    Else
        Set oFiles = Nothing
        ListDirectory = False
    End If
    
GetFiles_Exit:
    On Error Resume Next
    Exit Function

GetFiles_Err:
    ListDirectory = False
'    ReDim afiles(0) As String
    Select Case Err
        Case Else
            nLastErrorNr = Err.Number
            cLastErrorMessage = Err.Description
            Resume GetFiles_Exit
    End Select

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Returns the string from a buffer containing a null-terminated string
'   returned by an API call
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function StripNulls(OriginalStr As String) As String
      If (InStr(OriginalStr, Chr(0)) > 0) Then
         OriginalStr = Left(OriginalStr, _
          InStr(OriginalStr, Chr(0)) - 1)
      End If
      StripNulls = OriginalStr
End Function

Private Sub Class_Initialize()
    ' setup default port for ftp access
    nPort = 21
End Sub

Private Sub Class_Terminate()
    Disconnect
End Sub

Open in new window

Jim Dettman (EE MVE)

Haven't looked through your code, but one thing to be aware of is the FTP does not lock files, so it's possible to start up loading a file and before your finished up loading, the receiving system can grab it and as a result will get a zero length file.

That can be handled a number of ways:

1. Set schedule

2. Using a "flag" file to indicate that the processing of a file is complete. For example, sending MyFile.txt. Receiving end doesn't touch it until it see a coresponding MyFile.txt.complete, which you send after sending MyFile.txt

3. You rename the file after transmitting. Send MyFile.tmp. When complete, rename to MyFile.txt. Receiving end processes nothing but .txt files.

Jim.

fionafenton

ASKER

The receiving end isn't doing anything with the file at this point.
Processing of the file on the web server is scheduled with a cron job, so can't see that this is the problem.

Jim Dettman (EE MVE)

<<The receiving end isn't doing anything with the file at this point.
Processing of the file on the web server is scheduled with a cron job, so can't see that this is the problem. >>

OK. With that checked off then, something with the files themselves then? Are your transfering as ASCII or binary?

Jim.

SOLUTION

AlexPace

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

fionafenton

ASKER

I have tried specifying both ASCII and Binary and still the same problem.

I've tried uploading the file as MyFile.txt.tmp and still the same problem. The file is created but is empty.

I've run this on 2 different PCs behind different firewalls so don't think firewall is the problem.

I can manually upload the file using Filezilla, so any problem with the actual file can be discounted.

As far as I can tell it's being uploaded in passive mode.

AlexPace

The point of uploading the file as MyFile.txt.tmp and then, on success, renaming it to MyFile.txt is not to make it work but rather to avoid confusing the other side when it fails. It is a fail-safe to prevent the other side finding an incomplete file.

Your ability to find the root of the FTP problem is limited by the fact that the API calls are doing all the FTP protocol work and they don't have an option to create a log file.

To really debug it you'll either need the FTP server's log that includes a session attempted by your VB script or you'll need to use something like WireShark to make a log of the network traffic and then pick through that to find the FTP session... or you'll need to find a new FTP method that creates logs. Without a protocol log you can really only guess and try random things hoping that one of them works.

ASKER CERTIFIED SOLUTION

Jim Dettman (EE MVE)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

fionafenton

ASKER

After a lot of trial and error I appear to have solved the problem by not opening the ftp connection until the last moment and making sure that no other Cron job is running at the same time.
However I appreciate the help in trying to solve the problem.