• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

[Giúp] lấy đường dẫn tương đối cho các Shell

• Trang chủ

  • Thủ Thuật Access
  • Access Nâng Cao
  • Thủ thuật VBA
  • [Giúp] lấy đường dẫn tương đối cho các Shell
• [Giúp] lấy đường dẫn tương đối cho các Shell

• [Giúp] lấy đường dẫn tương đối cho các Shell

  dieuchinhlu > 17-06-11, 06:47 PM

  em có 1 Module để chạy các chương trình ngoài như máy tinh, notepad...
  em chỉ dẫn được đường truyền tuyệt đối thôi, muốn chuyển sang tương đối thì viết thể nào?
  
  
  

  Mã:

  Function App_MSEXCEL()
On Error GoTo App_MSEXCEL_Err

    Call Shell("D:\Program Files\Microsoft Office\Office14\EXCEL.EXE", 1)


App_MSEXCEL_Exit:
    Exit Function

App_MSEXCEL_Err:
    msgBoxOK Error$
    Resume App_MSEXCEL_Exit

End Function

  
  Em viết thế này thì báo File not Found
  
  

  Mã:

  Function App_Note()
On Error GoTo App_Note_Err

    Call Shell("%windir%\system32\notepad.exe", 1)


App_Note_Exit:
    Exit Function

App_Note_Err:
    msgBoxOK Error$
    Resume App_Note_Exit

End Function

  Giúp em với nha. thank thank nhìu.

• RE: [Giúp] lấy đường dẫn tương đối cho các Shell

  hieuvn > 18-06-11, 01:07 AM

  hi dieuchinhlu,
  Muốn làm được theo yêu cầu của bạn thì có 1 phương án sau:
  copy đoạn code sau vào 1 module:
  
  
  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
  
  chúc thành công
  
  
  
  

• RE: [Giúp] lấy đường dẫn tương đối cho các Shell

  phungminhluan > 26-03-17, 12:09 AM

  (18-06-11, 01:07 AM)hieuvn Đã viết: hi dieuchinhlu,
  Muốn làm được theo yêu cầu của bạn thì có 1 phương án sau:
  copy đoạn code sau vào 1 module:
  
  
  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
  
  chúc thành công
  
  Vậy thì nếu mình muốn mở word lên kèm theo mở một file word luôn thì code như thế nào, mong mọi người chỉ giáo

• Bài trước Bài tiếp