We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
COURSE of the MONTH
13 days, 6 hours left to enrollBecome a Premium Member and unlock a new, free course in leading technologies each month.
Solved
Access FTP bat file
Posted on 2013-05-29
I have this function that only works if I click the generated bat file. When it runs from access it does not work. In fact any batch file that I try will just open and close
Function FTP_Data()
'=========================
'FTP from Microsoft Access
'by Matthew V Carmichael
'Craetes FTP Batch File, FTP command file (txt)
'Default directory location of files to upload/download is
'the same location as the mdb file that contains this module.
'=========================
On Error GoTo Err_Trap
Dim pFile As Long
Dim strPath As String
Dim strFileName As String
Dim ftpServer As String
Dim strUserName As String
Dim strPassword As String
'Path and Name of file to FTP
strPath = "\"
strFileName = "somefile.TXT" 'Name of file to download
'FTP Server Settings
ftpServer = "ftp.xxxx.com"
strUserName = "xxx"
strPassword = "xxx"
'Create text file containing FTP commands
pFile = FreeFile
Open strPath & "FTP_cmd3.txt" For Output As pFile
Print #pFile, "user"
Print #pFile, strUserName
Print #pFile, strPassword
Print #pFile, "bi"
Print #pFile, "Get " & strFileName
Print #pFile, "quit"
Close pFile
'Create batch file to execute FTP
pFile = FreeFile
Open strPath & "FTP_Run3.bat" For Output As pFile
Print #pFile, "ftp -s:" & "FTP_cmd3.txt " & ftpServer
Print #pFile, "Pause"
Close pFile
'Execute FTP command
Shell strPath & "FTP_Run3.bat", 1
Err_Trap_Exit:
Exit Function
Err_Trap:
MsgBox Err.Number & " - " & Err.Description
Resume Err_Trap_Exit
End Function
Function FTP_Data()
'=========================
'FTP from Microsoft Access
'by Matthew V Carmichael
'Craetes FTP Batch File, FTP command file (txt)
'Default directory location of files to upload/download is
'the same location as the mdb file that contains this module.
'=========================
On Error GoTo Err_Trap
Dim pFile As Long
Dim strPath As String
Dim strFileName As String
Dim ftpServer As String
Dim strUserName As String
Dim strPassword As String
'Path and Name of file to FTP
strPath = "\"
strFileName = "somefile.TXT" 'Name of file to download
'FTP Server Settings
ftpServer = "ftp.xxxx.com"
strUserName = "xxx"
strPassword = "xxx"
'Create text file containing FTP commands
pFile = FreeFile
Open strPath & "FTP_cmd3.txt" For Output As pFile
Print #pFile, "user"
Print #pFile, strUserName
Print #pFile, strPassword
Print #pFile, "bi"
Print #pFile, "Get " & strFileName
Print #pFile, "quit"
Close pFile
'Create batch file to execute FTP
pFile = FreeFile
Open strPath & "FTP_Run3.bat" For Output As pFile
Print #pFile, "ftp -s:" & "FTP_cmd3.txt " & ftpServer
Print #pFile, "Pause"
Close pFile
'Execute FTP command
Shell strPath & "FTP_Run3.bat", 1
Err_Trap_Exit:
Exit Function
Err_Trap:
MsgBox Err.Number & " - " & Err.Description
Resume Err_Trap_Exit
End Function
[X]
Welcome to Experts Exchange
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
- Help others & share knowledge
- Earn cash & points
- Learn & ask questions
2 Comments
Active today
This:
Close pFile
Should be:
Close #pFile
Your also not waiting for the FTP process to complete. See code below.
Jim.
Function FTPUploadFile(strLocalFile
' Procedure to upload file to FTP site
' Uses standard windows client to upload file.
' Sends e-mail to ITALERT if upload fails and returns false.
Const RoutineName = "FTPUploadFile"
Const Version = "1.4"
Dim strFTPCommandFile As String
Dim strFTPScriptFile As String
Dim strFTPLogFile As String
Dim lngHWnd As Long
Dim intFileNum As Integer
Dim strMailMessage As String
Dim oOCS_SendMail As New OCS_SendMail
10 On Error GoTo FTPUploadFile_Error
' Generate file names
20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt"
30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat"
40 strFTPLogFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".log"
' Write script file
50 intFileNum = FreeFile
60 Open strFTPScriptFile For Output As #intFileNum
70 Print #intFileNum, strUserName
80 Print #intFileNum, strPassword
90 Print #intFileNum, "type " & IIf(strTransferType = "B", "binary", "ascii")
100 Print #intFileNum, "put " & Chr$(34) & strLocalFileName & Chr$(34) & " " & Chr$(34) & strFTPFilename & Chr$(34)
110 Print #intFileNum, "quit"
120 Close #intFileNum
' Write command file
130 intFileNum = FreeFile
140 Open strFTPCommandFile For Output As #intFileNum
150 Print #intFileNum, "@ftp -i -s:" & strFTPScriptFile & " " & strFTPSiteName & " > " & strFTPLogFile
160 Close #intFileNum
' Execute
170 lngHWnd = Shell(strFTPCommandFile, vbHide)
180 WaitWhileRunning (lngHWnd)
' Check log file
190 If IsValidFTP(strFTPLogFile) Then
200 FTPUploadFile = True
210 Else
220 If DebugMode() = True Then
230 Stop
240 FTPUploadFile = False
250 Else
260 oOCS_SendMail.SetParams "ITALERT", ".", "."
270 oOCS_SendMail.Subject = "FTP Upload failed"
280 strMailMessage = "The file: " & strLocalFileName & " did not upload." & vbCrLf
290 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf
300 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion()
310 oOCS_SendMail.Message = strMailMessage
320 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogFile
330 oOCS_SendMail.Send
340 FTPUploadFile = False
350 End If
360 End If
FTPUploadFile_Exit:
370 On Error Resume Next
380 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile
390 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile
400 If Dir(strFTPLogFile) <> "" Then Kill strFTPLogFile
410 Close #intFileNum
420 Exit Function
FTPUploadFile_Error:
430 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl
440 FTPUploadFile = False
450 Resume FTPUploadFile_Exit
End Function
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
' Used for wait check.
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Public Sub WaitWhileRunning(lngHWnd As Long)
Dim lngExitCode As Long
Dim lnghProcess As Long
10 lngExitCode = STILL_ACTIVE
20 lnghProcess = OpenProcess(PROCESS_QUERY_
30 If lnghProcess > 0 Then
40 Do While lngExitCode = STILL_ACTIVE
50 Call GetExitCodeProcess(lnghPro
60 DoEvents
70 Loop
80 End If
90 CloseHandle lnghProcess
End Sub
Close pFile
Should be:
Close #pFile
Your also not waiting for the FTP process to complete. See code below.
Jim.
Function FTPUploadFile(strLocalFile
' Procedure to upload file to FTP site
' Uses standard windows client to upload file.
' Sends e-mail to ITALERT if upload fails and returns false.
Const RoutineName = "FTPUploadFile"
Const Version = "1.4"
Dim strFTPCommandFile As String
Dim strFTPScriptFile As String
Dim strFTPLogFile As String
Dim lngHWnd As Long
Dim intFileNum As Integer
Dim strMailMessage As String
Dim oOCS_SendMail As New OCS_SendMail
10 On Error GoTo FTPUploadFile_Error
' Generate file names
20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt"
30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat"
40 strFTPLogFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".log"
' Write script file
50 intFileNum = FreeFile
60 Open strFTPScriptFile For Output As #intFileNum
70 Print #intFileNum, strUserName
80 Print #intFileNum, strPassword
90 Print #intFileNum, "type " & IIf(strTransferType = "B", "binary", "ascii")
100 Print #intFileNum, "put " & Chr$(34) & strLocalFileName & Chr$(34) & " " & Chr$(34) & strFTPFilename & Chr$(34)
110 Print #intFileNum, "quit"
120 Close #intFileNum
' Write command file
130 intFileNum = FreeFile
140 Open strFTPCommandFile For Output As #intFileNum
150 Print #intFileNum, "@ftp -i -s:" & strFTPScriptFile & " " & strFTPSiteName & " > " & strFTPLogFile
160 Close #intFileNum
' Execute
170 lngHWnd = Shell(strFTPCommandFile, vbHide)
180 WaitWhileRunning (lngHWnd)
' Check log file
190 If IsValidFTP(strFTPLogFile) Then
200 FTPUploadFile = True
210 Else
220 If DebugMode() = True Then
230 Stop
240 FTPUploadFile = False
250 Else
260 oOCS_SendMail.SetParams "ITALERT", ".", "."
270 oOCS_SendMail.Subject = "FTP Upload failed"
280 strMailMessage = "The file: " & strLocalFileName & " did not upload." & vbCrLf
290 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf
300 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion()
310 oOCS_SendMail.Message = strMailMessage
320 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogFile
330 oOCS_SendMail.Send
340 FTPUploadFile = False
350 End If
360 End If
FTPUploadFile_Exit:
370 On Error Resume Next
380 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile
390 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile
400 If Dir(strFTPLogFile) <> "" Then Kill strFTPLogFile
410 Close #intFileNum
420 Exit Function
FTPUploadFile_Error:
430 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl
440 FTPUploadFile = False
450 Resume FTPUploadFile_Exit
End Function
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
' Used for wait check.
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Public Sub WaitWhileRunning(lngHWnd As Long)
Dim lngExitCode As Long
Dim lnghProcess As Long
10 lngExitCode = STILL_ACTIVE
20 lnghProcess = OpenProcess(PROCESS_QUERY_
30 If lnghProcess > 0 Then
40 Do While lngExitCode = STILL_ACTIVE
50 Call GetExitCodeProcess(lnghPro
60 DoEvents
70 Loop
80 End If
90 CloseHandle lnghProcess
End Sub
Featured Post
Question has a verified solution.
If you are experiencing a similar issue, please ask a related question
As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
Suggested Courses
Course of the Month13 days, 6 hours left to enroll
777 members asked questions and received personalized solutions in the past 7 days.
Join the community of 500,000 technology professionals and ask your questions.