calling ftp.exe. Error Handling 1

[bgreen]

Hi I am executing a statement which calls ftp.exe. I am unsure how to error handle. It works when the proper user name and user id are entered. But if wrong user id or password is entered I have no error handling. How can I capture the output of the attempted ftp? And determine if the login/file transfer was successful?

Here's the code:

Private Sub cmdUpload_Click()
On Error Resume Next

Dim sResult As String, sFile As String
Dim sSVR As String, sFLD As String
Dim sUID As String, sPWD As String
Dim sLocalFLD As String

Dim Msg1, Msg2, Title

Msg1 = "Enter ftp site user id" ' Set prompt.
Title = "Ftp Login" ' Set title.
sUID = InputBox(Msg1, Title)

Msg2 = "Enter password" ' Set prompt.
sPWD = InputBox(Msg2, Title)

sSVR = ("ftp01")
sFLD = ("lifecomm\Ftp\Finance\INBOUND")

sLocalFLD = Me.lblPath.Caption


sFile = Nz(Me.cboUploadFile, "")

If sFile = "" Or Dir(sLocalFLD & "\" & sFile) = "" Then
MsgBox "The file cannot be found.", vbExclamation, "E R R O R"
Call cmdReadFolder_Click
Me.cboUploadFile.SetFocus
Exit Sub
End If

If sUID = "" Then
MsgBox "You must enter a user ID. Please try again.", vbExclamation, "E R R O R"
Me.cboUploadFile.SetFocus
Exit Sub
ElseIf sPWD = "" Then
MsgBox "You must enter a password. Please try again.", vbExclamation, "E R R O R"
Me.cboUploadFile.SetFocus
Exit Sub
Else

sResult = UploadFTPFile(sFile, sSVR, sFLD, sUID, sPWD, sLocalFLD)
Call cmdReadFolder_Click

End If

End Sub


Public Function UploadFTPFile(sFile As String, sSVR As String, sFLD As String, sUID As String, sPWD As String, sLocalFLD As String) As String

Dim sArchiveFLD As String
Dim sScrFile As String
Dim sSource As String
Dim sArchDest As String
Dim iFile As Integer
Dim sExe As String

Const q As String * 1 = """"

On Error GoTo Err_Handler
sArchiveFLD = sLocalFLD & "\ARCHIVE"

' will break if empty folder exist so error to pass
' must create folder first, so API calls work

On Error Resume Next
If Dir(sLocalFLD & "\") = "" Then MkDir (sLocalFLD)
On Error GoTo Err_Handler

sSource = q & sLocalFLD & "\" & sFile & q
sArchDest = q & sArchiveFLD & "\" & sFile & q
sScrFile = sLocalFLD & "\upload.scr"
If Dir(sScrFile) <> "" Then Kill sScrFile

' Open a new text file to hold the FTP script and load it with
' the appropriate commands.

iFile = FreeFile
Open sScrFile For Output As iFile
Print #iFile, "open " & sSVR
Print #iFile, sUID
Print #iFile, sPWD
Print #iFile, "cd " & sFLD
Print #iFile, "lcd " & q & sLocalFLD & q
Print #iFile, "put " & sFile
Print #iFile, "bye"
Close #iFile

sExe = Environ$("COMSPEC")
sExe = Left$(sExe, Len(sExe) - Len(Dir(sExe)))
sExe = sExe & "ftp.exe -s:" & q & sScrFile & q

ShellWait sExe, vbHide
DoEvents

Exit_Here:
DoCmd.Hourglass False

Call MoveAndRenameMyFile(sLocalFLD & "\", sFile, sArchiveFLD & "\" & sFile)

Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "E R R O R"
Resume Exit_Here
End Function

Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
On Error GoTo Err_Handler

Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long

' Initialize the STARTUPINFO structure:
With start
.cb = Len(start)
If Not IsMissing(WindowStyle) Then
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = WindowStyle
End If
End With
' Start the shelled application:
ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
ret& = CloseHandle(proc.hProcess)

Exit_Here:
Exit Sub
Err_Handler:
MsgBox Err.Description, vbExclamation, "E R R O R"
Resume Exit_Here

End Sub

 

[AlexCuse]

Using the shell, you can't return much. Luckily there is a dll available to you, called wininet.dll, that will allow you more control over FTP'ing.

See this FAQ's for declaration section and upload function: faq705-5904

And this FAQ's for a different upload function (I had trouble uploading encrypted files using 1DMF's upload function) and a download function: faq705-6533

I use the functions in the second one on a daily basis, and they work much better (for me) than the method you are using did.

Hope this helps,

Alex

Ignorance of certain subjects is a great part of wisdom

 

[bgreen]

I guess I should upload the other functions that are called. This all works but I need to error trap.

Module API_Functions:

Option Compare Database
Option Explicit

Private Const STARTF_USESHOWWINDOW& = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
On Error GoTo Err_Handler

Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long

' Initialize the STARTUPINFO structure:
With start
.cb = Len(start)
If Not IsMissing(WindowStyle) Then
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = WindowStyle
End If
End With
' Start the shelled application:
ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
ret& = CloseHandle(proc.hProcess)

MsgBox "1. " & Pathname
MsgBox "2. " & NORMAL_PRIORITY_CLASS
MsgBox "5. " & proc.hProcess

Exit_Here:
Exit Sub
Err_Handler:
MsgBox Err.Description, vbExclamation, "E R R O R"
Resume Exit_Here

End Sub

Module FTP_Functions:

Option Compare Database
Option Explicit

Public Function UploadFTPFile(sFile As String, sSVR As String, sFLD As String, sUID As String, sPWD As String, sLocalFLD As String) As String

Dim sArchiveFLD As String
Dim sScrFile As String
Dim sSource As String
Dim sArchDest As String
Dim iFile As Integer
Dim sExe As String
Dim sFTPErrLog As String

Const q As String * 1 = """"

On Error GoTo Err_Handler
sArchiveFLD = DLookup("ArchivePath", "tblDirectories")

' will break if empty folder exist so error to pass
' must create folder first, so API calls work

On Error Resume Next
If Dir(sLocalFLD & "\") = "" Then MkDir (sLocalFLD)
On Error GoTo Err_Handler

sSource = q & sLocalFLD & "\" & sFile & q
sArchDest = q & sArchiveFLD & "\" & sFile & q
sFTPErrLog = sLocalFLD & "\ftperrlog.txt"

sScrFile = sLocalFLD & "\upload.scr"
If Dir(sScrFile) <> "" Then Kill sScrFile

' Open a new text file to hold the FTP script and load it with
' the appropriate commands.

iFile = FreeFile
Open sScrFile For Output As iFile
Print #iFile, "open " & sSVR
Print #iFile, sUID
Print #iFile, sPWD
Print #iFile, "cd " & sFLD
Print #iFile, "lcd " & q & sLocalFLD & q
Print #iFile, "put " & sFile
Print #iFile, "bye"
Close #iFile

sExe = Environ$("COMSPEC")

sExe = Left$(sExe, Len(sExe) - Len(Dir(sExe)))

sExe = sExe & "ftp.exe -s:" & q & sScrFile & q
'sExe = sExe & "ftp.exe > " & sFTPErrLog & " -s:" & q & sScrFile & q
MsgBox "sexe: " & sExe

ShellWait sExe, vbHide
DoEvents

Call MoveAndRenameMyFile(sLocalFLD & "\", sFile, sArchiveFLD & "\" & sFile)

Exit_Here:
DoCmd.Hourglass False
Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "E R R O R"
Resume Exit_Here
End Function

Public Function MoveAndRenameMyFile(SourcePath As String, SourcePattern As String, Destination As String) As Boolean

'=======================================================
'Call MoveAndRenameMyFile("C:\My Documents\", "File2*.xls", "C:\My Documents\Sales\Processed2.xls")
'=======================================================

Dim oFso As Object
Dim MyFile As String

On Error GoTo ErrorOut

Set oFso = CreateObject("Scripting.FileSystemObject")
MyFile = Dir(SourcePath & SourcePattern)


'Loop until a matching file is found
Do Until LenB(MyFile) = 0

'Pattern matching check
If UCase$(MyFile) Like UCase$(SourcePattern) Then

'Found a similar file. Make sure we are not copying it to the same location
If StrComp(SourcePath & MyFile, Destination, vbTextCompare) <> 0 Then

'Copy to new location, OVERWRITING any file with the same name.
'Then DELETE the original
Call oFso.CopyFile(SourcePath & MyFile, Destination, True)
Call oFso.DeleteFile(SourcePath & MyFile, True)
MsgBox "File has been archived in -> " & Destination, vbInformation
Else
'Failed!
Err.Raise vbObjectError + 512 + 101, "MoveAndRenameMyFile", "Source and Destination identical"
End If
'Success
Exit Do
End If
Call Dir
Loop

ErrorOut:
If Err.Number <> 0 Then
MsgBox "There was a problem archiving the file", vbExclamation
Err.Raise Err.Number, "MoveAndRenameMyFile", Err.Description
Else

If LenB(MyFile) = 0 Then
Err.Raise vbObjectError + 512 + 101, "MoveAndRenameMyFile", "No File Found"
Else
MoveAndRenameMyFile = True 'Success!
End If
End If
End Function

Form FTP_FILE:

Option Compare Database
Option Explicit

Private Sub cboUploadFile_Enter()
On Error Resume Next
Me.cboUploadFile.Dropdown
End Sub


Private Sub Form_Open(Cancel As Integer)
On Error Resume Next

DoCmd.Restore

Call cmdReadFolder_Click

End Sub

Private Sub RefreshFileList()
On Error Resume Next

Dim sLocalFLD As String
Dim sFile As String
Dim sFieldList As String

Const q As String * 1 = """"

' sLocalFLD = Nz(Me.lblPath.Caption, "")
sLocalFLD = DLookup("LocalPath", "tblDirectories")

sFile = Dir(sLocalFLD & "\")
Do Until sFile = ""
If Right(sFile, 4) <> ".scr" And sFile <> "ftperrlog.txt" Then ' And sFile <> "FileList.txt" Then
sFieldList = sFieldList & q & sFile & q & ";"
End If
sFile = Dir()
Loop
Me.cboUploadFile.RowSource = sFieldList

End Sub

Private Sub cmdReadFolder_Click()
On Error Resume Next

Me.cboUploadFile = Null
Me.cboEnvironment = Null

Call RefreshFileList

End Sub

Private Sub cmdUpload_Click()
On Error Resume Next

Dim sResult As String, sFile As String
Dim sSVR As String, sFLD As String
Dim sRootDir As String, sLocation As String
Dim sUID As String, sPWD As String
Dim sLocalFLD As String

Dim sEnv As String


sUID = DLookup("User", "tblFTPSite")

sPWD = DLookup("Pwd", "tblFTPSite")

sSVR = DLookup("Site", "tblFTPSite")

sLocalFLD = DLookup("LocalPath", "tblDirectories")
sRootDir = DLookup("ServerFolder", "tblDirectories")
sLocation = DLookup("Location", "tblDirectories")

sEnv = Nz(Me.cboEnvironment, "")

If sEnv = "" Then
MsgBox "The Environment cannot be empty.", vbExclamation, "E R R O R"
Me.cboEnvironment.SetFocus
Exit Sub
End If

sFLD = (sRootDir & "\" & sEnv & "\" & sLocation)

sFile = Nz(Me.cboUploadFile, "")

If sFile = "" Or Dir(sLocalFLD & "\" & sFile) = "" Then
MsgBox "The file cannot be found.", vbExclamation, "E R R O R"
Call cmdReadFolder_Click
Me.cboUploadFile.SetFocus
Exit Sub
End If

sResult = UploadFTPFile(sFile, sSVR, sFLD, sUID, sPWD, sLocalFLD)

Call cmdReadFolder_Click

End Sub

 

[AccessGuruCarl]

Hello bgreen,

If you really want to use ftp.exe....

You need to add a LOG....
' Open a new text file to hold the FTP script and load it with
' the appropriate commands.

iFile = FreeFile
Open sScrFile For Output As iFile
Print #iFile, "LOG C:\FTP_Transfer.log"
Print #iFile, "open " & sSVR
....
....
Add a timer control... Set Interval to 0
Enabled = False
Just before ShellWait...
Me.Timer1.Enabled = True
Me.Timer1.Interval = 3000
Have it read the log file for a Success or Failure

Only way around it........
FYI...
Make sure delete the file when finished...
Or before new FTP...
LOG --- Appends the details if the file already exists!

Hope this helps...


AccessGuruCarl
Programmers helping programmers
you can't find a better site.

 

[AccessGuruCarl]

Slight error in my post...

The LOG function is part of WS_FTP Pro scripting...

However, you can use Trace in ftp.exe

The log is not as easy to read as the ftp pro script but it will give you the results....

Open Help in XP and Type FTP
Then click -- Ftp subcommands

Try adding the status command after the open...
This will give you consistant trace log, so you'll know what line to read...

AccessGuruCarl
Programmers helping programmers
you can't find a better site.

 

[bgreen]

I have looked into the trace sub command but am unsure how to add this to my code. Do you have an idea?

 

[AccessGuruCarl]

Sorry bgreen...

I didn't look into the commands to see if they were same...

Trace in WS_FTP Pro creates a detailed log file...
Trace in ftp.exe only turns on packet tracing...

Although you can still create your own log by piping the output of the ftp.exe!

Modify your ShellWait to this....
sExe = sExe & "ftp.exe -s:" & q & sScrFile & q & "> c:\ftp_log.txt"

You don't need to worry about killing the file first...
Or creating it...
If it doesn't exist it will be created!
Each time it runs... It will overwrite the original!

Do a search on google for:
ftp server response codes

Now just open the file and loop it, checking the codes...

FYI...
You can purchase WS_FTP Pro for about $55.
It has scripting ability - with easy to read log files!
Built in error handling...
It also has a built in scheduler...

Hope this helps you out....





AccessGuruCarl
Programmers helping programmers
you can't find a better site.

 

[AccessGuruCarl]

Alex...

I use the functions in the second one on a daily basis

What are your file sizes?

I've been trying numerous different code examples...
But cannot get any of them to work consistantly!

I'm uploading 2 files: 250MB and a 220MB
One file is a setup.exe file, the other file is a rarred secured mdb file(client update).

I'm uploading these in Binary Mode, and I consistantly get Internet Write File Errors... after about 70-80 percent of the first file uploaded!

If I reduce the size using a test file, I can upload about 100MB files before it starts giving out errors again.
Usually it's error # 12030, but I've also got 12007, 12033.

Any Idea's
I'd prefer to do this all from VB and eliminate my customer from having to resort to WS_FTP Pro, which seems to be the only way we've successfully got these to upload.

AccessGuruCarl
Programmers helping programmers
you can't find a better site.

 

[bgreen]

Hi AccessGuruCarl,

I apreciate the suggestion....

I have tried:

sExe = sExe & "ftp.exe -s:" & q & sScrFile & q & "> c:\ftp_log.txt"

And it does not work. The file does not get transferred nor does it create a log file. Any other suggestion?

 

[AlexCuse]

Carl -

which function are you using? The one written by 1DMF did not work so well when I needed to upload encrypted or zipped files, even small ones. The files would be corrupted when brought down on the other side. I think it is because the files are written in chunks.

The upload function that I wrote has been working well for me (I don't need the status bar) but file sizes rarely exceed a couple megs. This is kind of a pain to discuss in a forum like this (without being able to send screen shots, large chunks of code, and what not easily). Perhaps you could email me through the 'Send a Comment to AlexCuse About This FAQ' link in my FAQ's, and I will get back to you?

Also, I am not an expert on FTP by any stretch of the imagination, do you know off-hand what those errors mean?

Ignorance of certain subjects is a great part of wisdom

 

[AccessGuruCarl]

bgreen --

It may be due to the shell wait..
I didn't test it using shell wait

I fired it off from a .bat file

Open notepad...
PathAndFilename is your sScrFile

Paste this...
ftp.exe -sathAndFileName > c:\ftp_log.txt

Save it as All Files...
And name it LoadFtp.bat

If you save it in the same folder as the sScrFile, then you only need to add the filename after -s:

The same for the log, the c:\ is not needed...

Double click the .bat file and it should work!

I think I just realized why it didn't run from VB
You need to add a space between the quote and the less then symbol... See revised below...

sExe = sExe & "ftp.exe -s:" & q & sScrFile & q & " > c:\ftp_log.txt"

Let me know if you have anymore problems...

AccessGuruCarl
Programmers helping programmers
you can't find a better site.

 

[bgreen]

sExe = sExe & "ftp.exe -s:" & q & sScrFile & q & " > c:\ftp_log.txt"
didn't work.

I would be hard for me to do it in notepad because variable are created in the access app.

 

[AccessGuruCarl]

Create the .bat file to verify it works..

It should!!!!

Let me know the outcome...

What Operating System are you using: 2000 or XP
What version of Access - 97, 2000, XP, 2003

I'll create an mdb file, and test it with shellwait, I know this works, I've used it a long time ago, but I could have sworn then that there was a LOG function for ftp. But I could be mistaken, and piped the output like I've shown here.

Any DOS app that outputs info to a screen, will also output to a file. See piping output from a dos app. Goggle It...

In ftp help...
-s:FileName
Specifies a text file that contains ftp commands. These commands run automatically after ftp starts. This parameter allows no spaces. Use this parameter instead of redirection (<).

I'll build a sample mdb tonight, and test it.


AccessGuruCarl
Programmers helping programmers
you can't find a better site.

 

[AccessGuruCarl]

Hello bgreen,

You are correct...
It cannot run from within access as is...

You need to add this...

Dim sBatFile As String
Dim sLogFile As String

   sScrFile = "c:\ftp.txt"  'Your file with the ftp commands

[COLOR=blue]'Your code
   iFile = FreeFile
   Open sScrFile For Output As iFile
   Print #iFile, "open " & sSVR
   Print #iFile, sUID
   Print #iFile, sPWD
   Print #iFile, "cd " & sFLD
   Print #iFile, "lcd " & q & sLocalFLD & q
   Print #iFile, "put " & sFile
   Print #iFile, "bye"
   Close #iFile
[/color]
' Add This after your Close #iFile
   sBatFile = "c:\ftp1.bat" 'The batch file to kick it off
   sLogFile = " > c:\ftp_log2.txt"
   iFile = FreeFile
   Open sBatFile For Output As iFile
   Print #iFile, "ftp.exe -s:" & sScrFile & sLogFile
   Close #iFile
   
   ' The output of the .bat file should resemble this:
   ' ftp.exe -s:c:\ftp.txt > c:\ftp_log2.txt
   
   'Set a timer interval to read the log file...
   Me.TimerInterval = 60000 ' 1 minute
   
   ' You can't use ShellWait -- with a timer
   ' you'll need to modify your code if you want to be able
   ' to read the file before it finishes, and have it do
   ' the move files in the timer event either after reading in
   ' code 226 transfer complete or the 221 GoodBye.
   
   'ShellWait sBatFile, vbNormalFocus
    Shell sBatFile, vbHide
    Exit Sub

FYI...

You shouldn't need to do a comspec to run the ftp.exe
You should be able to run this file from anywhere in the system.

If you notice the sample output for the batfile I gave,
I can move this .bat file to any folder, and still run it.

Hope this solve's your problems...
But I still prefer to handle this in the VBA environment instead of outputing to a dos app...

I forgot to mention....
If you try to read the file before ftp finishes,
YOU MUST OPEN IT IN SHARED MODE -- Or ftp may fail when it tries to write to the file. I'd open it, Read the entire file in... Close it, then loop through it use the Left function to grab the first three characters to read.
If 226 - transfer was a success, Call your move files function!

AccessGuruCarl
Programmers helping programmers
you can't find a better site.

 

[bgreen]

That creates the log file! Awsome help!

Do you have any code suggestions to read the log file? Search for code 226 transfer complete? I have no experience doing this.

Once again, awsome help!

 

[AccessGuruCarl]

Hello bgreen,

Here is some starter code to read the log file.

Dim ftplog As String
Dim iFile As Integer
Dim InputData As String
Dim strRetn As String

ftplog = "c:\ftp_log.txt"
iFile = FreeFile
Open ftplog For Input Shared As #iFile   ' Open file for shared input.
Do While Not EOF(iFile)   ' Check for end of file.
    Line Input #iFile, InputData   ' Read line of data.
        strRetn = Left$(InputData, 3)   'Return first 3 characters of line read
            Select Case strRetn
                Case 221    'Goodbye!
                    'Do something
                    MsgBox "Goodbye...."
                Case 226    'Transfer complete
                    'Do something
                Case 230    'User Logged In
                    'Continue
                Case Else
                    'MsgBox strRetn  'Left here for testing...
            End Select
Loop
Close #iFile   ' Close file.

As mentioned in earlier post...
For MS Access, I'd place this in the timer event section.
and then on button click of your ftp, set the timer interval.

You may want to set the interval twice...
The first time, maybe 15 seconds or something like that to check if they logged in. Then reset it to check every minute or so to see if it uploaded.

Do a search on google for 'ftp server response codes' to complete the Select Case...

Good luck...
Let me know how you make out.

AccessGuruCarl
Programmers helping programmers
you can't find a better site.

 

[bgreen]

Awsome help! All is working as suggested.