Public Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SW_SHOWNORMAL = 1
Public Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" _
(lpExecInfo As SHELLEXECUTEINFO) As Long
Public Const SE_ERR_FNF = 2
Public Const SE_ERR_NOASSOC = 31
Public Declare Function WaitForSingleObject Lib "kernel32.dll" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Const INFINITE = &HFFFF
Public Const WAIT_TIMEOUT = &H102
Sub Upload1()
Dim sei As SHELLEXECUTEINFO ' structure used by the function
Dim retval As Long ' return value
' Load the information needed to open C:\Bootlog.txt into the structure.
With sei
' Size of the structure
.cbSize = Len(sei)
' Use the optional hProcess element of the structure.
.fMask = SEE_MASK_NOCLOSEPROCESS
' Handle to the window calling this function.
' .hwnd = Me.hwnd
' The action to perform: open the file.
.lpVerb = "open"
' The file to open.
.lpFile = strPath + "IT3CW32.EXE"
' No additional parameters are needed here.
.lpParameters = strPath + "CARTONS.DAT +R +E +V"
' The default directory -- not really necessary in this case.
.lpDirectory = ""
' Simply display the window.
.nShow = SW_SHOWNORMAL
' The other elements of the structure are either not used
' or will be set when the function returns.
End With
' Open the file using its associated program.
retval = ShellExecuteEx(sei)
If retval = 0 Then
' The function failed, so report the error. Err.LastDllError
' could also be used instead, if you wish.
Select Case sei.hInstApp
Case SE_ERR_FNF
MsgBox "Program not found."
Case SE_NOASSOC
MsgBox "No associate"
Case Else
MsgBox "Unexpected Error"
End Select
Else
' Wait for the opened process to close before continuing. Instead of waiting once
' for a time of INFINITE, this example repeatedly checks to see if the process
' is still open. This allows the DoEvents VB function to be called, preventing
' our program from appearing to lock up while it waits.
Do
DoEvents
retval = WaitForSingleObject(sei.hProcess, 0)
Loop While retval = WAIT_TIMEOUT
' MsgBox "Operation Completed"
bUpload = True
End If
End Sub