| I recently received a few questions via various forums for Visual Basic on how to FTP files. The questions center specifically around scheduled jobs. So, I opted to write a quick little Visual Basic application utilizing the Inet control. There are numerous implementations that could have been chosen such as the Windows Scripting Host inside of VBScript, Windows API calls, etc... I chose Visual Basic primarily for the audience that asked the question in the first place. Plus, for scheduled jobs, it provided the cleanest method to check for failures during the process and would certainly make troubleshooting network problems much easier. |
' Here's the code for frmFTP
Option Explicit
Private msCurrentFile As String
Friend Sub FTPFile(ByVal sFTPServer As String, _
ByVal sFTPCommand As String, _
ByVal sFTPUser As String, _
ByVal sFTPPwd As String, _
ByVal sFTPSrcFileName As String, _
ByVal sFTPTgtFileName As String)
Dim oFS As Scripting.FileSystemObject
Dim sURL As String
On Error GoTo FTPFileExit
Me.HRG True
msCurrentFile = ""
Set oFS = New Scripting.FileSystemObject
sURL = "ftp://" & sFTPServer
Inet1.Protocol = icFTP
Inet1.RequestTimeout = 60
Inet1.RemotePort = 21
Inet1.AccessType = icDirect
Inet1.URL = sURL
Inet1.UserName = sFTPUser
Inet1.Password = sFTPPwd
Select Case sFTPCommand
Case "PUT"
msCurrentFile = sFTPSrcFileName
If oFS.FileExists(sFTPSrcFileName) = False Then GoTo FTPFileExit
Inet1.Execute sURL, sFTPCommand & Space(1) & sFTPSrcFileName & " " & sFTPTgtFileName
Case "GET"
msCurrentFile = sFTPTgtFileName
If oFS.FileExists(sFTPTgtFileName) = True Then
oFS.DeleteFile sFTPTgtFileName, True
end if
Inet1.Execute sURL, sFTPCommand & Space(1) & sFTPSrcFileName & " " & sFTPTgtFileName
End Select
Me.WaitForResponse
Inet1.Execute sURL, "quit"
Me.WaitForResponse
FTPFileExit:
Set oFS = Nothing
HRG False
End Sub
Friend Sub WaitForResponse()
Dim fWait As Boolean
On Error GoTo ErrHandler
fWait = True
Do Until fWait = False
DoEvents
fWait = Inet1.StillExecuting
Loop
ErrHandler:
Err.Clear
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
On Error Resume Next
Select Case State
Case icNone
Case icResolvingHost: Me.lblRESPONSE.Caption = "Resolving Host"
Case icHostResolved: Me.lblRESPONSE.Caption = "Host Resolved"
Case icConnecting: Me.lblRESPONSE.Caption = "Connecting..."
Case icConnected: Me.lblRESPONSE.Caption = "Connected"
Case icResponseReceived: Me.lblRESPONSE.Caption = "Transferring File..."
Case icDisconnecting: Me.lblRESPONSE.Caption = "Disconnecting..."
Case icDisconnected: Me.lblRESPONSE.Caption = "Disconnected"
Case icError: MsgBox "Error:" & Inet1.ResponseCode & " " & Inet1.ResponseInfo
Case icResponseCompleted: Me.lblRESPONSE.Caption = "Process Complete."
End Select
Me.lblRESPONSE.Refresh
Err.Clear
End Sub
Friend Sub HRG(fShowHourGlass As Boolean)
If fShowHourGlass = True Then
Screen.MousePointer = 11
Else
Screen.MousePointer = 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmFTP = Nothing
End Sub
' Here's the code for FTPMain.bas
' Remember to set your project start up to Sub Main()
Public Sub Main()
Load frmFTP
frmFTP.Show
frmFTP.FTPFile "my ip address", "PUT", "myuser", "mypwd", "C:\temp\test.txt", "test.txt"
frmFTP.FTPFile "my ip address", "GET", "myuser", "mypwd", "test.txt", "c:\temp\test2.txt"
Unload frmFTP
End Sub
|