HTML Code:
Option Compare Database
Option Explicit
Sub CreateFTPScript()
On Error GoTo Err_CreateFTPScript 'Initialize error handling.
'Dim dbs As Database
Dim dbs As DAO.Database
Dim q_FtpScript As DAO.Recordset
Dim q_TelcoDatasets As DAO.Recordset
Dim strPathName As String
Dim strUserID As String
Dim strPassword As String
Dim MyData As DAO.Recordset
Dim FileNo As Integer
Dim tfile As String
strPathName = "K:\DPE\SHARED\TAPE\DITCO\FASTPAY FILES PENDING TO BE PROCESSED\UPLOAD\"
Set dbs = CurrentDb
Set q_FtpScript = dbs.OpenRecordset("Q_FTPSCRIPT", dbOpenDynaset)
Set q_TelcoDatasets = dbs.OpenRecordset("q_TelcoDataSets", dbOpenDynaset)
Set MyData = dbs.OpenRecordset("tblData")
'****************************************************************************
'Changed from this code below
If q_FtpScript.EOF Then
'Changed to this code below to handle ERROR CODE 3021
'If q_FtpScript.EOF Or MyData.EOF Then
'Does not work
MsgBox "FTP Script not created"
'****************************************************************************
Exit Sub
Else
Close #99
Open strPathName & "ftpscrpt.bat" For Output As #99
Print #99, "echo off"
Print #99, "cls"
Print #99, "if exist ftpscrpt.txt goto norun"
Print #99, "echo running ftp script"
Print #99, "ftp -s:ftpscrpt > ftpscrpt.txt"
Print #99, "echo ftp script run"
Print #99, "GoTo done"
Print #99, ": norun"
Print #99, "echo ftp was run previously, not run this time"
Print #99, ": done"
Print #99, "echo ."
Print #99, "echo ."
Print #99, "echo ."
Print #99, "echo have a nice day"
Print #99, "pause"
Close #99
Open strPathName & "ftpscrpt" For Output As #99
q_FtpScript.MoveFirst
Call Get_FTP_UserID_Password(q_FtpScript, strUserID, strPassword)
Do Until q_FtpScript.EOF
Print #99, "open " & q_FtpScript![ip_addr]
Print #99, strUserID
Print #99, strPassword
Print #99, "ascii"
FileNo = 1
MyData.MoveFirst
Do While Not MyData.EOF
tfile = DLookup("[telcodatasets]", "tbltelcodatasets", "[SetNo]= " & FileNo)
Print #99, "Put " & MyData![FileName] & " '" & tfile & "'"
FileNo = FileNo + 1
'============================================================================
====
'If FileNo > 17 Then
' MsgBox "You have more files to load then you have datasets avaialable, please remove the excess files and then click button again to create FTP SCRIPT. Thanks"
'Exit Sub
'End If
'============================================================================
====
MyData.MoveNext
Loop
'Print #99, "Put " & q_FtpScript![file_name] & ".txt" & " " & "'" & q_TelcoDatasets![TelcoDatasets] & "'"
Print #99, "close"
q_FtpScript.MoveNext
Loop
Print #99, "quit"
Close
End If
Set q_FtpScript = Nothing
Set dbs = Nothing
Exit_CreateFTPScript: ' Label to resume after error.
Exit Sub ' Exit before error handler.
Err_CreateFTPScript: ' Label to jump to on error.
MsgBox Err & " " & Error$ ' Place error handling here.
Resume Exit_CreateFTPScript ' Pick up again and quit.
MsgBox "FTP Script created, please goto your UPLOAD FOLDER and run FTPSCRPT.BAT. Once this is complete, please click on CHECK 250 TRANSFER BUTTON for count, then proceed to next step...", vbExclamation
End Sub
Sub Get_FTP_UserID_Password(q_FtpScript, strUserID, strPassword)
strUserID = Trim(Nz(q_FtpScript![user_id]))
strPassword = Trim(Nz(q_FtpScript![Password]))
Do Until strUserID <> ""
strUserID = InputBox("Enter User ID for" & Chr(13) & _
"" & Chr(13) & _
"IP Address: " & q_FtpScript![ip_addr] & Chr(13) & _
"System: " & q_FtpScript![actng_sys] & Chr(13) & _
"Site ID: " & q_FtpScript![site_id] & Chr(13) & _
"File Name: " & q_FtpScript![file_name], "Enter User ID", "")
If Len(strUserID) = 0 Then
MsgBox "YOU MUST ENTER A USERID, TRY AGAIN!"
End If
strPassword = ""
Loop
Do Until strPassword <> ""
strPassword = InputBox("Enter Password for" & Chr(13) & _
"User ID: " & strUserID & Chr(13) & _
"IP Address: " & q_FtpScript![ip_addr] & Chr(13) & _
"System: " & q_FtpScript![actng_sys] & Chr(13) & _
"Site ID: " & q_FtpScript![site_id] & Chr(13) & _
"File Name: " & q_FtpScript![file_name], "Enter Password", "")
If Len(strPassword) = 0 Then
MsgBox "YOU MUST ENTER A PASSWORD, TRY AGAIN!"
End If
Loop
End Sub