jeffrey.demulling at usbank.com
jeffrey.demulling at usbank.com
Thu Apr 29 10:00:27 CDT 2004
Here is code that I use:
Sub runftp()
Dim db As Database
Dim Mytitle
Dim ReturnValue
Dim myFTPDir As String
Dim strSQL As String
Dim qdf As QueryDef
Dim myfilenumber As String
Dim myfiledate As String
Dim myexportfile As String
Dim saveasname As String
Dim rst_Databases As Recordset
Dim rst_reports As Recordset
Dim myReportName As String
Dim mySaveName As String
Dim myftpfilename As String
Dim mylocation As String
Dim myfile As String
Dim mysection As String
Dim mykey As String
Dim myname As String
Dim sSetting
Dim mydatafile As String
Dim mymessage As String
Dim SearchPath As String
Dim FindStr As String
Dim NumFiles As Integer
Dim NumDirs As Integer
Dim FileSize As Long
Dim FileNum As Integer
Dim mytext As String
'Create the Batch File for FTPing
SearchPath = CurrentDBDir
FindStr = "ftpbm.bat"
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
If NumFiles <> 0 Then
Kill SearchPath & FindStr
End If
FileNum = FreeFile
Open SearchPath & "ftpbm.bat" For Output As #FileNum 'SearchPath & FindStr
For Input As #1
mytext = "@Echo Off"
Print #FileNum, mytext
mytext = "TITLE FTP BONDMASTER FILES"
Print #FileNum, mytext
mytext = "Echo OFF"
Print #FileNum, mytext
mytext = "CLS"
Print #FileNum, mytext
mytext = "@ECHO FTPing BondMaster Data..."
Print #FileNum, mytext
mytext = "ftp -s:" & SearchPath & "bmftp.txt"
Print #FileNum, mytext
' Close before reopening in another mode.
Close #FileNum
'Create FTP Script File
SearchPath = CurrentDBDir
FindStr = "bmftp.txt"
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
If NumFiles <> 0 Then
Kill SearchPath & FindStr
End If
FileNum = FreeFile
Open SearchPath & "bmftp.txt" For Output As #FileNum 'SearchPath & FindStr
For Input As #1
mytext = "open bmprod1.int.usbc.com"
Print #FileNum, mytext
mytext = "ftc_ftp"
Print #FileNum, mytext
mytext = "transfer"
Print #FileNum, mytext
Set db = DBEngine(0)(0)
'If there is a record for the Operators Report create strings for FTP
here
Set rst_reports = db.OpenRecordset("tblErrors")
Set rst_Databases = db.OpenRecordset("tblDataBaseNames")
If rst_reports.recordcount <> 0 Then
rst_reports.MoveFirst
Do Until rst_reports.EOF
If InStr(1, rst_reports.Fields("Error"), "TAPEPBPASSWD") <> 0
Then
rst_Databases.MoveFirst
Do Until rst_Databases.EOF
If rst_reports.Fields("DataBase") =
rst_Databases.Fields("DataBaseLongName") Then
myFTPDir = rst_Databases.Fields
("DataBaseFTPAddressTapeFiles")
myReportName = right(rst_reports.Fields("Error"),
30)
mySaveName = "BMOperators.txt"
mytext = "cd " & myFTPDir
Print #FileNum, mytext
mytext = "get " & myReportName & " " &
Me.txtSavedDataLocation & mySaveName
Print #FileNum, mytext
End If
rst_Databases.MoveNext
Loop
End If
rst_reports.MoveNext
Loop
End If
'If there is a record for the Loan Bal Info Reports create strings for
FTP here
Set rst_reports = db.OpenRecordset("tempreport")
Set rst_Databases = db.OpenRecordset("tblDataBaseNames")
If rst_reports.recordcount <> 0 Then
rst_reports.MoveFirst
Do Until rst_reports.EOF
rst_Databases.MoveFirst
Do Until rst_Databases.EOF
If rst_reports.Fields("dbName") = rst_Databases.Fields
("DataBaseLongName") Then
myFTPDir = rst_Databases.Fields
("DataBaseFTPAddressTapeFiles")
myReportName = rst_reports.Fields("txtReport")
mySaveName = "LoanBalInfo-" & rst_Databases.Fields
("DataBaseLongName") & ".txt"
mytext = "cd " & myFTPDir
Print #FileNum, mytext
mytext = "get " & myReportName & " " &
Me.txtSavedDataLocation & mySaveName
Print #FileNum, mytext
End If
rst_Databases.MoveNext
Loop
rst_reports.MoveNext
Loop
End If
mytext = "disconnect"
Print #FileNum, mytext
mytext = "close"
Print #FileNum, mytext
' Close before reopening in another mode.
Close #FileNum
'***** This is the command to use when ftping so do not need message box
myftpfilename = CurrentDBDir & "ftpbm.bat"
Call ShellWait(myftpfilename, 1)
Set rst_Databases = Nothing
Set rst_reports = Nothing
Set db = Nothing
End Sub
THIS CODE IS IN ITS OWN MODULE
Option Compare Database
Option Explicit
'***************** Code Start ******************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Terry Kreft
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
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private 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
Private Declare Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long
Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
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)
End Sub
'***************** Code End ****************
"Steven W. Erbach"
<serbach at new.rr.com> To: "Access Developers discussion and problem solving"
Sent by: <accessd at databaseadvisors.com>
accessd-bounces at databasea cc:
dvisors.com Subject: [AccessD] A2K: Using the shell() function
04/29/2004 09:52 AM
Please respond to "Access
Developers discussion and
problem solving"
Dear Group,
I'm in the thick of writing a custom EDI purchase order processing
application in Access 2000. The 850 purchase orders are downloaded from the
VAN (Value Added Network) mailbox using Windows FTP commands in a DOS batch
file, and the additional documents (855 PO Acknowledgment, 856 Advance Ship
Notice, 810 Invoice, and 997 Functional Acknowledgment) are uploaded to the
mailbox with another DOS batch file using Windows FTP commands.
The process works, but I've had to insert MsgBox statements in the Access
code alerting the user that he should wait until the DOS batch file has
completed processing the FTP commands and is closed before continuing with
the Access stuff.
My question is this: do any of you lot have any techniques for 1)
determining when a DOS batch file has finished (that is, the title bar of
the DOS window says "Finished"); and 2) closing those windows without user
intervention?
I'm just about ready to tell my client that he should buy WS_FTP Pro so
that we can set up a macro or whatever you do in WS_FTP to automagically
download and upload and close the WS_FTP program. I'm still not sure about
what to do in Access so that it knows that an external application has
completed its operations. Is this a DDE thing?
I've been experimenting with the FMS Total Visual Sourcebook that I bought
some time ago. It has a class library and some sample code for logging into
an FTP site and selecting and downloading files. I just know, however, that
my client will balk at the additional delay while I figure out an
Access-only method for getting and sending EDI documents.
The DOS batch thing works but there are the additional clicks involved with
closing the DOS window and then clicking the MsgBox OK button to continue
processing. Any ideas?
Regards,
Steve Erbach
Scientific Marketing
Neenah, WI
920-969-0504
"One of the differences in the two parties is that the Republicans always
have problems filling many of the offices that are political, because most
competent people would rather do something other than work for the
government..." - Jerry Pournelle
--
_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com