Latest News

the latest news from our team

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

Leave a Reply

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