FTP Transfer (MDMFTP) and VBA

MdmFTP in VBA

The MdmFTP session
The MdmFTP session can be called from any Visual Basic for Applications (VBA) application.

Sub FTP_Upload()

'Exists Action
Const gcCancel = 0
Const gcReplace = 1
Const gcPrompt = 2
Const gcAppend = 3

'Direction
Const gcUpload = 0
Const gcDownload = 1

'File Type
Const gcASCII = 0
Const gcBinary = 1

'Host Type
Const htAUTO = 0
Const htUNIX = 1
Const htIBM_VM = 2
Const htVMS_MULTINET = 3
Const htVMS_UCX = 4
Const htPCTCP = 5
Const htNCSA = 6
Const htNOS = 7
Const htQVT = 8
Const htIBM_TCP = 9
Const htCHAMELEON = 10
Const htSUPER = 11
Const htSINTFTPD = 12
Const htMVS = 13
Const htU5000 = 14
Const htMPEIX = 15
Const htSUNOS = 16

Dim FTPSession As Object

On Error GoTo Egress1
Set FTPSession = CreateObject("FTP.Session")
FTPSession.HostAddress = "ftp_test.minisoft.com"
FTPSession.HostType = htUNIX
FTPSession.LoginUser = "neal"
FTPSession.UserPassword = InputBox("User Password")

If (Not FTPSession.Connect) Then
MsgBox "1 - " & FTPSession.ErrorMessage
GoTo Egress1
End If

If (Not FTPSession.LoginStatus) Then
MsgBox "2 - " & FTPSession.ErrorMessage
GoTo Egress1
End If

FTPSession.DisplayStats = True
If (FTPSession.StoreFile("C:\AUTOEXEC.BAT", "AUTOEXEC.BAT", gcASCII, gcReplace) <> 0) Then
MsgBox "3 - " & FTPSession.ErrorMessage
GoTo Egress1
End If
GoTo Egress2

Egress1:
MsgBox "Error Exit"

Egress2:
If FTPSession.ConnectStatus = True Then
FTPSession.Disconnect
End If
Set FTPSession = Nothing

End Sub

Private Sub Timer1_Timer()
Dim TempStr As String

On Error GoTo Egress1

Timer1.Interval = 0
StatusLine = "Checking..."
List1.Text = ""
List1.Text = FTSession.HostFileList(tHFName)
If (Len(List1.Text) = 0) Then
DownloadFile
Else
Timer1.Interval = 1000
End If

GoTo Egress2

Egress1:
On Error Resume Next
MsgBox "Error Exit"
If FTSession.ConnectStatus = True Then
FTSession.Disconnect
End If
Set FTSession = Nothing
Egress2:
StatusLine = "Ready"

End Sub

Private Sub DownloadFile()
Dim TempStr As String

StatusLine = "Transfering..."
FTSession.DisplayStats = True
FTSession.Direction = gcDownload
FTSession.ExistsAction = 1
TempStr = tDLName.Text
If (Len(TempStr) > 1) Then
FTSession.LocalFile = TempStr
End If
TempStr = tDLName.Text
If (Len(TempStr) > 1) Then
FTSession.HostFile = TempStr
End If
FTSession.RecordSize = 80
FTSession.TransferMode = gcASCII
StatusLine = "Logon Successful - Transfering..."
If (FTSession.StartTransfer <> 0) Then
MsgBox "3 - " & FTSession.ErrorMessage
GoTo Egress1
End If
StatusLine = "Transfer Complete."

GoTo Egress2

Egress1:
On Error Resume Next
MsgBox "Error Exit"
If FTSession.ConnectStatus = True Then
FTSession.Disconnect
End If
Set FTSession = Nothing
Egress2:
StatusLine = "Ready"
Screen.MousePointer = 0

End Sub

!JOB VBJOB2,MGR/password.MINISOFT
!CONTINUE
!PURGE VBJOB3
!COPY NPREADME,VBJOB3
!PURGE VBJOB1
!SET STDLIST=DELETE
!EOJ