'Note
'I am pasting this in in the order in which it is called
' by the menu item
'dimmed in a module
Private Declare Function FindExecutable Lib "shell32.dll" Alias _
"FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, _
ByVal lpResult As String) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess _
As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub mnuOpenDB_Click()
Dim StrAppName As String, StrFileName As String
Screen.MousePointer = vbHourglass
' Hide.
Me.Visible = False
'Do other stuff
DoEvents
StrFileName = App.path & "\" & "OrdOut.mdb"
'Find the path to the Access Executable
'and build the command string to open the Database
StrAppName = Get_Program_Path(StrFileName) & _
" " & StrFileName
'Run The App and wait till it is closed
ShellAndWait StrAppName, vbNormalFocus
'refresh the controls
EmData.Refresh
EData.Refresh
LoadEmailListBox
loadFileList
LstFilesSaved.Refresh
LstEmailAdds.Refresh
' Reappear.
Me.Visible = True
Screen.MousePointer = vbDefault
End Sub
Public Function Get_Program_Path(StrPassedFName) As String
Dim sAccess As String, StrFileName As String
StrFileName = StrPassedFName
'This could be your File String too
''App.path & "\" & "OrdOut.mdb"
' Use the "FindExecutable" API to return the path
'To the App associated with the filename.
sAccess = Space(260)
Call FindExecutable(StrFileName, "", ByVal sAccess)
sAccess = Replace(Trim(sAccess), Chr(0), "")
If Len(sAccess) <> 0 Then
'MsgBox sAccess, vbInformation, "The Path to Access is"
GetAccess_Path = sAccess
End If
End Function
Public Sub ShellAndWait(ByVal program_name As String, ByVal window_style As VbAppWinStyle)
Dim process_id As Long
Dim process_handle As Long
Dim lngdb As Long
' Start the program.
On Error GoTo ShellError
process_id = Shell(program_name, window_style)
'process_id = ShellExecute(Me.hwnd, "open", program_name, vbNullString, App.path, 1)
On Error GoTo 0
' Wait for the program to finish.
' Get the process handle.
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, INFINITE
CloseHandle process_handle
End If
Exit Sub
ShellError:
MsgBox "Error starting task " & _
program_name & vbCrLf & _
Err.Description, vbOKOnly Or vbExclamation, _
"Error"
End Sub