• Trang chủ click to expand contents 

  • [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