Mở ứng dụng bất kỳ từ Access

Share by: hieuvn
Forum: thủ thuật access
Vui lòng giữ đường dẫn và tác giả nếu bạn dùng lại hoặc share module này



---------------------------------------------------------------------------------------------------
Tạo một module bất kỳ, dán nội dung sau vào.

Option Compare Database
Option Explicit

Const errFileNotFound = 53

Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Sub RunAppWait(strCommand As String, intMode As Integer)
' Run an application, waiting for its completion
' before returning to the caller.

Const PROCESS_QUERY_INFORMATION = &H400
Const SYNCHRONIZE = &H100000

Const STILL_ACTIVE = &H103&

Dim hInstance As Long
Dim hProcess As Long
Dim lngExitCode As Long

On Error GoTo HandleError
' Start up the application.
hInstance = Shell(strCommand, intMode)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or SYNCHRONIZE, _
True, hInstance)
Do
' Attempt to retrieve the exit code, which will
' not exist until the application has quit.
Call GetExitCodeProcess(hProcess, lngExitCode)
DoEvents
Loop Until lngExitCode <> STILL_ACTIVE

ExitHere:
Exit Sub

HandleError:
Select Case Err.Number
Case errFileNotFound
MsgBox "Unable to find '" & strCommand & "'"
Case Else
MsgBox Err.Description
End Select
Resume ExitHere
End Sub

sau đó bạn muốn mở ứng dụng nào thì chỉ cần gọi tên ưng dụng đó mà không cần quan tâm đến đường dẫn nữa, ví dụ nút bấm để mở notepad:

Private Sub Command0_Click()
RunAppWait "NOTEPAD.EXE", vbMaximizedFocus
MsgBox "Da mo NOTEPAD."
End Sub

tương tự với nút nhấn mở excel:

Private Sub Command1_Click()
RunAppWait "excel.EXE", vbMaximizedFocus
MsgBox "Da mo excel."
End Sub