FTP files using Microsoft Access

I have an import/export client that runs their entire operation with Microsoft Access as a backbone application. This company has been in Fastcompany for a couple of years now.

Today I had the opportunity to go back and slightly modify some FTP code to download/upload transaction files.
They sell their merchandise through Amazon, Walmart, Houzz, and more. Today we added Hayneedle.
So I thought I might share the code necessary to perform an FTP transfer.

Please note that this code assumes you have a ‘zstblInformation’ table set up containing the FTP credentials:
strWayfairFTPServer = DLookup(“WayfairFTPSite”, “zstblInformation”)
strWayfairFTPUser = DLookup(“WayfairFTPUser”, “zstblInformation”)
strWayfairFTPPassword = DLookup(“WayfairFTPPassword”, “zstblInformation”)
strWayfairFTPFolder = DLookup(“WayfairFTPFolder”, “zstblInformation”)

Give me a call at 804 928 4111 if you have problems implementing this code.
This code does not require a library to be installed in Access.

Option Compare Database
Option Explicit

‘Open the Internet object
Private Declare PtrSafe 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

‘Connect to the network
Private Declare PtrSafe 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

‘Get a file using FTP
Private Declare PtrSafe 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

‘Send a file using FTP
Private Declare PtrSafe 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

‘Close the Internet object
Private Declare PtrSafe Function InternetCloseHandle _
Lib “wininet.dll” _
(ByVal hInet As Long) As Integer
Public Sub subPerformFTP(pPathAndFile_To_Send As String, pServerName As Variant, pLogonName As String, pLogonPassword As String, pRemoteDirectory As Variant, pRemoteFileName As String, pUPLOAD_OR_DOWNLOAD As String)

Dim strRemoteDir As String
Dim strRemoteFile As String
Dim strLocalFile As String

Dim strRemoteDir2 As String
Dim strRemoteFile2 As String
Dim strLocalFile2 As String

On Error GoTo Err_f_PerformFTP

DoCmd.Hourglass True

FTPClient.ServerName = pServerName
FTPClient.UserName = pLogonName
FTPClient.Password = pLogonPassword

FTPClient.OpenFTP
FTPClient.OpenServer

Select Case pUPLOAD_OR_DOWNLOAD

Case Is = “Upload”
strRemoteDir = pRemoteDirectory
strRemoteFile = pRemoteFileName
strLocalFile = pPathAndFile_To_Send
FTPClient.PutFile strRemoteDir, strRemoteFile, strLocalFile, “ASC”

Case Is = “Download”
strRemoteDir2 = pRemoteDirectory
strRemoteFile2 = pRemoteFileName
strLocalFile2 = pPathAndFile_To_Send
FTPClient.GetFile strRemoteDir2, strRemoteFile2, strLocalFile2, “ASC”

End Select

FTPClient.CloseServer
FTPClient.CloseFTP

Exit_f_PerformFTP:
DoCmd.Hourglass False
Exit Sub

Err_f_PerformFTP:
MsgBox Err.Number & ” ” & Err.Description, vbCritical, “Error in f_PerformFTP module”
Resume Exit_f_PerformFTP

End Sub

Public Sub subFTPTestWayfair()

Dim strPathFileForUpload As String
Dim strFileForUpload As String

Dim strWayfairFTPServer As String
Dim strWayfairFTPUser As String
Dim strWayfairFTPPassword As String
Dim strWayfairFTPFolder As String

strPathFileForUpload = “Z:\Operations\Wayfair\Inventory\Jackzzz.xlsx”
strFileForUpload = Format(Date, “yymmdd”) & ” Wayfair Inventory FOR FTP.csv”

strWayfairFTPServer = DLookup(“WayfairFTPSite”, “zstblInformation”)
strWayfairFTPUser = DLookup(“WayfairFTPUser”, “zstblInformation”)
strWayfairFTPPassword = DLookup(“WayfairFTPPassword”, “zstblInformation”)
strWayfairFTPFolder = DLookup(“WayfairFTPFolder”, “zstblInformation”)

‘subPerformFTP(pPathAndFile_To_Send As String, pServerName As Variant, pLogonName As String, pLogonPassword As String, pRemoteDirectory As Variant, pRemoteFileName As String, pUPLOAD_OR_DOWNLOAD As String)

‘subPerformFTP strPathFileForUpload, strWayfairFTPServer, strWayfairFTPUser, strWayfairFTPPassword, “Inventory”, strFileForUpload, “Upload”
subPerformFTP strPathFileForUpload, strWayfairFTPServer, strWayfairFTPUser, “PASSWORD”, “inventory”, “jackzzz.xlsx”, “Upload”
MsgBox strPathFileForUpload & ” has been FTP’d.”

End Sub

Public Sub subGetAllFTPFiles(pServerName As Variant, pLogonName As String, pLogonPassword As String, pRemoteDirectory As Variant, pLocalDirectory As Variant, pFileType As Variant)

Dim strRemoteDir As String
Dim strRemoteFile As String
Dim strLocalFile As String

Dim strRemoteDir2 As String
Dim strRemoteFile2 As String
Dim strLocalFile2 As String

On Error GoTo Err_f_GetAllFTPFiles

DoCmd.Hourglass True

FTPClient.ServerName = pServerName
FTPClient.UserName = pLogonName
FTPClient.Password = pLogonPassword

FTPClient.OpenFTP
FTPClient.OpenServer
FTPClient.ClearFileNames
FTPClient.GetFileNames pRemoteDirectory, pFileType

Dim strFileName As String
Dim iFiles As Integer
iFiles = 0
iFiles = FTPClient.FileNames.Count

Dim i As Integer

If iFiles > 0 Then
i = 1
While i <= iFiles
strFileName = FTPClient.FileNames(i)
FTPClient.GetFile pRemoteDirectory, strFileName, pLocalDirectory & “\” & strFileName
i = i + 1
Wend
End If

FTPClient.CloseServer
FTPClient.CloseFTP

Exit_f_GetAllFTPFiles:
DoCmd.Hourglass False
Exit Sub

Err_f_GetAllFTPFiles:
MsgBox Err.Number & ” ” & Err.Description, vbCritical, “Error in f_FindAllFTPFiles module”
Resume Exit_f_GetAllFTPFiles

End Sub

This entry was posted in Access 2007 problems/solutions, Access Code Examples, Microsoft Access Solutions and tagged , , . Bookmark the permalink.

Leave a Reply

Your email address will not be published. Required fields are marked *