Chương 4: Thực thi chương trình

Như vậy chúng ta đã bước qua giai đoạn sơ cấp, kể từ chương này chúng ta sẽ bước vào giai đoạn trung cấp.
Nội dung của chương này bao gồm:







 
4.1 Điểm chú ý trong khi tham khảo Module đi kèm tập sách này
Do đặc điểm là các bài viết trên diễn đàn, vì vậy chúng tôi sẽ không cung cấp ngay cho các bạn các file ví dụ mẫu. Thay vào đó, nói tới ví dụ nào thì diễn đàn sẽ cung cấp file ví dụ đó.

Ngoài ra, chúng ta có một quy ước riêng, các hàm API sẽ được khai báo ở Module0. Từ Module1 trở đi sẽ chỉ đơn thuần viết code VBA. Do đó nếu bạn chỉ xem từ Module1 trở đi thì sẽ không thấy các khai báo hàm API, xin hãy lưu ý điều này.
Ở bất cứ Module nào cũng có thể gọi các hàm API vì vậy chúng ta sẽ khai báo chúng dưới dạng Public.

Về xử lý lỗi: Có rất nhiều ví dụ mà chúng ta sẽ đề cập tới, nhắm tới mục đích giới thiệu hàm API là chính, do đó code sẽ viết dưới dạng đơn giản nhất có thể, về cơ bản sẽ không có các xử lý lỗi. Thay vào đó, khi thực thi hàm API sẽ hiển thị giá trị trả về cho biết việc thực thi thành công hay là không. Dựa vào giá trị trả về đó, nếu bạn muốn viết code cho phần xử lý lỗi, xin hãy tự phân chia thành các trường hợp.

Về Win64 với Win32: Nội dung của cuốn sách này sẽ tập trung vào code của Win64 API. Về code của Win 32 API sẽ có một bảng liệt kê mà chúng tôi sẽ cung cấp, bạn có thể tham khảo sau.
Ngoài ra, chúng tôi cũng đã thuyết minh về sự khác biệt giữa code của Win 64 API và Win 32 API, các bạn hãy ôn tập lại.

Win 32 API không có từ khóa PtrSafe khi khai báo trong câu lệnh Declare.
Kiểu giá trị trả về của hàm hay kiểu dữ liệu của đối số nếu là LongPtr thì trong Win 32 API sẽ chuyển thành Long.
 

tuhocvba

Administrator
Thành viên BQT
4.2 Tránh khởi động nhiều ứng dụng
Nếu Notepad chưa được mở thì khởi động mở Notepad

Trường hợp nếu chúng ta dùng hàm Shell để khởi động mở Notepad thì ta sẽ không phán đoán được là Notepad đã đang được mở hay chưa, như vậy mỗi lần thực thi chương trình thì lại có một cửa sổ Notepad mới mở ra.
Với Windows, khi khởi động một ứng dụng (application) nào đó thì nó sẽ tạo ra window cho application đó. Ta gọi là application window.
Bạn cần đăng nhập để thấy đính kèm

Tất cả các appication window thuộc về class.
Nói tóm lại nếu như có một hàm API dựa trên class này và trả về handle (hiểu tượng trưng tương tự như mã số chưng minh dân) của application thì dựa trên giá trị trả về này ta có thể viết lệnh điều kiện và phòng tránh được việc cùng một ứng dụng nhưng lại được mở ra quá nhiều cửa sổ. (Ví dụ: cửa sổ notepad1, cửa sổ notepad2,...).
Trong ví dụ dưới đây, chúng ta sẽ khởi động notepad nếu nó chưa được mở.
Trước hết hãy xem ví dụ WIN 64API
Module0:
'----------------------------------------------------------------------
'Dua ra class name hoac caption va nhan ve handle cua window
'
'Gia tri tra ve: Thanh cong = lay duoc handle window
'           That bai = NULL
'----------------------------------------------------------------------
Declare PtrSafe Function FindWindow Lib "user32" _
      Alias "FindWindowA" _
      (ByVal lpClassName As String, _
      ByVal lpWindowName As String) As LongPtr
Module1:
'**********************************
'Phong tranh mo nhieu cua so ung dung
'**********************************

Sub FindWindow_Sample()
    Dim strClassName As String  'Class name
    Dim rc As LongPtr
   
    Dim lngProcessID As Long    'Gia tri tra ve cua ham Shell
   
    'Chi dinh class name
    strClassName = "Notepad"
       
    'Lay handle cua Notepad window
    rc = FindWindow(strClassName, _
                    vbNullString)
                   
                   
    'Neu notepad dang duoc mo thi se khong khoi dong notepad
    If rc <> 0& Then
        MsgBox "Notepad dang duoc mo"
        Exit Sub
    End If
   
    'Khoi dong mo Notepad
    lngProcessID = Shell("Notepad.exe", vbNormalFocus)
   
    'Neu khong khoi dong duoc Notepad thi hay su dung doan code duoi day.
'Tuy vao tung OS (he dieu hanh may tinh) ma duong dan duoi day co the se khac,
'truong hop do ban can thay doi lai duong dan file exe trong code nay cho phu hop
    'lngProcessID = Shell("C:\Windows\Notepad.exe", vbNormalFocus)
End Sub
(Còn nữa)
 

Euler

Administrator
Thành viên BQT
4.2 Tránh khởi động nhiều ứng dụng
Nếu Notepad chưa được mở thì khởi động mở Notepad

Sau đây ta sẽ viết code cho Win 32 API:
Những nơi khai báo là LongPtr thì chuyển thành Long. Từ khóa Ptrsafe nếu có thì bỏ đi.
Module0:
'----------------------------------------------------------------------
'Dua ra class name hoac caption va nhan ve handle cua window
'
'Gia tri tra ve: Thanh cong = lay duoc handle window
'           That bai = NULL
'----------------------------------------------------------------------
Declare Function FindWindow Lib "user32" _
      Alias "FindWindowA" _
      (ByVal lpClassName As String, _
      ByVal lpWindowName As String) As Long
Module1:
'**********************************
'Phong tranh mo nhieu cua so ung dung
'**********************************

Sub FindWindow_Sample()
    Dim strClassName As String  'Class name
    Dim rc As Long
 
    Dim lngProcessID As Long    'Gia tri tra ve cua ham Shell
 
    'Chi dinh class name
    strClassName = "Notepad"
     
    'Lay handle cua Notepad window
    rc = FindWindow(strClassName, _
                    vbNullString)
                 
                 
    'Neu notepad dang duoc mo thi se khong khoi dong notepad
    If rc <> 0& Then
        MsgBox "Notepad dang duoc mo"
        Exit Sub
    End If
 
    'Khoi dong mo Notepad
    lngProcessID = Shell("Notepad.exe", vbNormalFocus)
 
    'Neu khong khoi dong duoc Notepad thi hay su dung doan code duoi day.
'Tuy vao tung OS (he dieu hanh may tinh) ma duong dan duoi day co the se khac,
'truong hop do ban can thay doi lai duong dan file exe trong code nay cho phu hop
    'lngProcessID = Shell("C:\Windows\Notepad.exe", vbNormalFocus)
End Sub
Sau đây, chúng ta cùng điểm qua một số ứng dụng phổ biến trên Windows:
Application WindowsClass
NotePadNotePad
PaintMSPaintApp
WordPadWordPadClass
ExcelXLMAIN
WordOpusApp
Outlookrctrl_renwnd32
PowerPointPPTFrameClass
Ở đây tôi không ghi Acess, calculator, hay muốn khởi động userform trên Excel thì làm thế nào. Tôi sẽ cung cấp danh sách đầy đủ này sau.

Ghi chú:
Từ Excel 2002 trở đi, thông qua thuộc tính Hwnd có thể lấy được Handler của Application Windows.
Ở ví dụ trên chúng ta đã lấy handler của NotePad. Đối với Excel, đó là ứng dụng chúng ta đang chạy code, cho nên class của nó là XLMAIN. Vì vậy, ta có thể lấy được handler của Excel như sau:
Mã:
rc = FindWindow("XLMAIN", vbNullString)
Thực tế, các phiên bản Excel cũ hơn cho tới Excel 2000, người ta lấy handler bằng phương pháp này. Nhưng từ Excel 2002 trở đi, chúng ta có thể dùng thuộc tính Hwnd để lấy handler của Application.
Mã:
rc = Application.Hwnd
Đối với Visual Basic, từ xưa tới giờ vẫn có thể sử dụng thuộc tính Hwnd nhưng không thể nói la nó tốt hơn cách sử dụng hàm FindWindow.
Nếu sử dụng thuộc tính Hwnd, từ Excel 2000 trở về trước (cũ hơn), chương trình sẽ bị lỗi.
Đối với việc sử dụng hàm API trong VBA, không nên dùng thuộc tính Hwnd, nên sử dụng hàm API FindWindow.
File demo:
 

tuhocvba

Administrator
Thành viên BQT
4.3 Chờ để thực thi chương trình cho tới khi ứng dụng kết thúc
Chương trình tạm dừng cho tới khi NotePad kết thúc

Trong trường hợp chúng ta dùng hàm Shell để khởi động một Application (ví dụ NotePad), dù cho Application này chưa kết thúc thì chương trình VBA vẫn tiếp tục được thực thi. Điều đó có thể nói là việc thực thi như vậy là không đồng bộ, bởi vì như đã nói ở chương 2, Windows thực thi các chương trình không đồng thời cùng lúc.
Ở ví dụ tiếp theo, chúng ta suy nghĩ làm sao để chương trình VBA sẽ tạm dừng không thực thi các câu lệnh tiếp theo cho tới khi hàm Shell khởi động xong NotePad.
Win64-Module2:
'Ham tra ve handler cua process object
'gia tri tra ve:
'thanh cong = handler cua process
'that bai = NULL
Declare PtrSafe Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, _
    ByVal InheriHandle As Long, _
    ByVal dwProcessId As Long) As LongPtr 'Win64: LongPtr

Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_TERMINATE = &H1&
Public Const PROCESS_CREATE_THREAD = &H2&
Public Const PROCESS_VM_OPERATION = &H8&
Public Const PROCESS_VM_READ = &H10&
Public Const PROCESS_VM_WRITE = &H206&
Public Const PROCESS_DUP_HANDLE = &H40&
Public Const PROCESS_CREATE_PROCESS = &H80&
Public Const PROCESS_SET_INFORMATION = &H200&
Public Const PROCESS_QUERY_INFORMATION = &H400&
Public Const PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

'Ham tra ve trang thai ket thuc process
'Gia tri tra ve
'Thanh cong = khac 0
'That bai = 0

Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As LongPtr, _
    lpExitCode As Long) As LongPtr 'Win64: LongPtr
'Phan doan process ket thuc hay chua
'Neu chua ket thuc se cat STILL_ACTIVE
Public Const STATUS_PENDING = &H103&
Public Const STILL_ACTIVE = STATUS_PENDING
'Ham close process cua tien trinh dang duoc mo
'gia tri tra ve
'thanh cong = khac 0
'that bai = 0
Declare PtrSafe Function CloseHandle Lib "kernel32" _
    (ByVal hObject As LongPtr) As LongPtr

'=======================================
'vi du ve viec tam dung chuong trinh vba cho cho ham Shell ket thuc
'
'
'
'
'=======================================

Sub GetExitCodeProcess_Sample()
    Dim lngProcessID As Long 'Gia tri tra ve cua ham Shell
    Dim lngProcess      As LongPtr 'Gia tri tra ve cua ham OpenProcess 'Win64: LongPtr
    Dim lngExitCode     As Long 'Code ket thuc
    Dim rc              As LongPtr 'Win64: LongPtr
    MsgBox "Sau khi xac nhan NotePad da duoc mo, hay dong NotePad"
    
    'Khoi dong NotePad
    lngProcessID = Shell("Notepad.exe", vbNormalFocus)
    
    'Lay handler cua process object cua ung dung duoc mo boi ham Shell
    lngProcess = OpenProcess(PROCESS_QUERY_INFORMATION, _
                                1, _
                                lngProcessID)
    'GetExitCodeProcess se lay trang thai ket thuc cua process
    'trong khi process chua ket thuc thi thuc hien DoEvents de cap nhat OS
    Do
        rc = GetExitCodeProcess(lngProcess, lngExitCode)
        DoEvents
    Loop While lngExitCode = STILL_ACTIVE
    'Close handler object dang duoc mo
    rc = CloseHandle(lngProcess)
    
    MsgBox "NotePad da ket thuc"

    
End Sub
File demo :
 

Euler

Administrator
Thành viên BQT
Các bạn có thể thay thế code của Module2 bằng code dưới đây để có thể chạy được cả với Win32 (và Win64):
Mã:
'Ham tra ve handler cua process object
'gia tri tra ve:
'thanh cong = handler cua process
'that bai = NULL
#If Win64 Then
    Declare PtrSafe Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, _
    ByVal InheriHandle As Long, _
    ByVal dwProcessId As Long) As LongPtr 'Win64: LongPtr
#Else
    Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, _
    ByVal InheriHandle As Long, _
    ByVal dwProcessId As Long) As Long
#End If

Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_TERMINATE = &H1&
Public Const PROCESS_CREATE_THREAD = &H2&
Public Const PROCESS_VM_OPERATION = &H8&
Public Const PROCESS_VM_READ = &H10&
Public Const PROCESS_VM_WRITE = &H206&
Public Const PROCESS_DUP_HANDLE = &H40&
Public Const PROCESS_CREATE_PROCESS = &H80&
Public Const PROCESS_SET_INFORMATION = &H200&
Public Const PROCESS_QUERY_INFORMATION = &H400&
Public Const PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

'Ham tra ve trang thai ket thuc process
'Gia tri tra ve
'Thanh cong = khac 0
'That bai = 0
#If Win64 Then
    Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As LongPtr, _
    lpExitCode As Long) As LongPtr 'Win64: LongPtr
#Else
    Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, _
    lpExitCode As Long) As Long
#End If
'Phan doan process ket thuc hay chua
'Neu chua ket thuc se cat STILL_ACTIVE
Public Const STATUS_PENDING = &H103&
Public Const STILL_ACTIVE = STATUS_PENDING
'Ham close process cua tien trinh dang duoc mo
'gia tri tra ve
'thanh cong = khac 0
'that bai = 0
#If Win64 Then
    Declare PtrSafe Function CloseHandle Lib "kernel32" _
    (ByVal hObject As LongPtr) As LongPtr
#Else
    Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long
#End If

'=======================================
'vi du ve viec tam dung chuong trinh vba cho cho ham Shell ket thuc
'
'
'
'
'=======================================

Sub GetExitCodeProcess_Sample()
    Dim lngProcessID As Long 'Gia tri tra ve cua ham Shell
    #If Win64 Then
        Dim lngProcess      As LongPtr 'Gia tri tra ve cua ham OpenProcess 'Win64: LongPtr
        Dim rc              As LongPtr 'Win64: LongPtr
    #Else
        Dim lngProcess      As Long
        Dim rc              As Long
    #End If
    Dim lngExitCode     As Long 'Code ket thuc
    
    MsgBox "Sau khi xac nhan NotePad da duoc mo, hay dong NotePad"
    
    'Khoi dong NotePad
    lngProcessID = Shell("Notepad.exe", vbNormalFocus)
    
    'Lay handler cua process object cua ung dung duoc mo boi ham Shell
    lngProcess = OpenProcess(PROCESS_QUERY_INFORMATION, _
                                1, _
                                lngProcessID)
    'GetExitCodeProcess se lay trang thai ket thuc cua process
    'trong khi process chua ket thuc thi thuc hien DoEvents de cap nhat OS
    Do
        rc = GetExitCodeProcess(lngProcess, lngExitCode)
        DoEvents
    Loop While lngExitCode = STILL_ACTIVE
    'Close handler object dang duoc mo
    rc = CloseHandle(lngProcess)
    
    MsgBox "NotePad da ket thuc"

    
End Sub
 

giaiphapvba

Administrator
Thành viên BQT
4.4 Gửi đi tin nhắn không thông qua hàng đợi tin nhắn
Để tin nhắn được gửi đi mà không thông qua hàng đợi, chúng ta sẽ sử dụng hàm SendMessager. Ở ví dụ lần này, tôi sẽ dùng hàm này để gửi đi thông báo cho hệ điều hành windows đóng ứng dụng Notepad.
Module3:
'Gui messeger toi window duoc chi dinh
'Gia tri tra ve: Tuy thuoc vao kieu messeger ma gia tri tra ve khac nhau
#If Win64 Then
    Declare PtrSafe Function SendMessager Lib "user32" _
    Alias "SendMessageA" _
    (ByVal hwnd As LongPtr, _
    ByVal wMsg As Long, _
    ByVal wPara As Long, _
    lParam As Any) As LongPtr
#Else
    Declare Function SendMessager Lib "user32" _
    Alias "SendMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wPara As Long, _
    lParam As Any) As Long
#End If
'Messeger duoc gui toi window (cai ma system menu duoc thao tac)
Public Const WM_SYSCOMMAND = &H112
'Ket thuc window
Public Const SC_CLOSE = &HF060&
'That bai
Public Const ERROR_SUCCESS = 0&

Sub SendMessage_Sample()
    #If Win64 Then
        Dim hwnd As LongPtr
        Dim rc   As LongPtr
        
    #Else
        Dim hwnd As Long
        Dim rc   As Long
    #End If
    'Lay handler cua window notepad
    hwnd = FindWindow("Notepad", vbNullString)
    
    If hwnd = ERROR_SUCCESS Then
        MsgBox "Notepad chua duoc khoi dong", vbExclamation
    End If
    
    rc = SendMessager(hwnd, WM_SYSCOMMAND, SC_CLOSE, 0)
    
End Sub
Để chạy thử code, trước hết bạn cần mở Notepad, sau đó chạy code trên, chương trình sẽ gửi đi thông báo đóng Notepad, hệ điều hành sẽ thực thi đóng Notepad.
File demo:
(Còn nữa)
 
4.4 Gửi đi tin nhắn không thông qua hàng đợi tin nhắn
(tiếp theo và hết)
Để đóng tất cả các cửa sổ Notepad, chúng ta sẽ sử dụng vòng lặp Do~Loop.
Mã:
Sub SendMessage_Sample2()
    #If Win64 Then
        Dim hwnd As LongPtr
        Dim rc   As LongPtr
        
    #Else
        Dim hwnd As Long
        Dim rc   As Long
    #End If
    'Lay handler cua window notepad
    hwnd = FindWindow("Notepad", vbNullString)
    
    If hwnd = ERROR_SUCCESS Then
        MsgBox "Notepad chua duoc khoi dong", vbExclamation
    End If
    Do While hwnd <> ERROR_SUCCESS
        rc = SendMessager(hwnd, WM_SYSCOMMAND, SC_CLOSE, 0)
        hwnd = FindWindow("Notepad", vbNullString)
    Loop
    
End Sub
 

tuhocvba

Administrator
Thành viên BQT
4.5 Lấy Class/Caption của Window
Hàm GetWindowText sẽ lấy caption của window.
Ngược lại, hàm GetClassName sẽ lấy class của window. Ở hàm này, để di chuyển tới đối tượng window tiếp theo, ta có hàm GetNextWindow, ngoài ra khi kết hợp với hàm IsWindowVisible (để kiểm tra xem trạng thái của một window là nhìn thấy được hay là không), chúng ta có thể lấy được caption của toàn bộ các cửa sổ window và class của chúng.
Ở ví dụ dưới đây, chúng ta sẽ lấy toàn bộ class và caption của các window.
Module4:
'Lay handle window cua cua so window tiep theo
'Gia tri tra ve:
'Thanh cong = handle window
'That bai: = 0
#If Win64 Then
    Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _
            (ByVal hwnd As LongPtr, _
            ByVal wFlag As Long) As LongPtr
#Else
    Declare Function GetNextWindow Lib "user32" Alias "GetWindow" _
            (ByVal hwnd As Long, _
            ByVal wFlag As Long) As Long
#End If

'Lay trang thai window la xem duoc hay la khong
'Gia tri tra ve:
'Thanh cong :  <> 0
'That bai: = 0
#If Win64 Then
    Declare PtrSafe Function IsWindowVisible Lib "user32" _
    (ByVal hwnd As LongPtr) As LongPtr
#Else
    Declare Function IsWindowVisible Lib "user32" _
    (ByVal hwnd As Long) As Long
#End If

'Lay caption tilte cua window
'Gia tri tra ve:
'Thanh cong: so byte cua text da duoc copy
'That bai: = 0
#If Win64 Then
    Declare PtrSafe Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
    (ByVal hwnd As LongPtr, _
    ByVal lpstring As String, _
    ByVal cch As Long) As LongPtr
#Else
    Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
    (ByVal hwnd As Long, _
    ByVal lpstring As String, _
    ByVal cch As Long) As Long
#End If

'Lay class name cua window
'Gia tri tra ve:
'Thanh cong: so byte da doc
'That bai: = 0
#If Win64 Then
    Declare PtrSafe Function GetClassName Lib "user32" _
    Alias "GetClassNameA" _
    (ByVal hwnd As LongPtr, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As LongPtr
#Else
    Declare Function GetClassName Lib "user32" _
    Alias "GetClassNameA" _
    (ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long
#End If
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2

Sub GetClassName_Sample()
    #If Win64 Then
        Dim hwnd As LongPtr
    #Else
        Dim hwnd As Long
    #End If
    Dim strClassName As String * 100
    Dim strCaption As String * 60
   
 
   
    hwnd = FindWindow(vbNullString, vbNullString)
   
    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("Sheet2").Activate
   
    Columns("A:B").Clear
    Cells(1).Resize(, 2).Value = Array("Caption", "ClassName")
    Do
        If IsWindowVisible(hwnd) Then
            GetWindowText hwnd, strCaption, Len(strCaption)
           
            GetClassName hwnd, strClassName, Len(strClassName)
           
            With Cells(Rows.Count, 1).End(xlUp).Offset(1)
                .Value = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
                .Offset(, 1).Value = Left(strClassName, _
                InStr(strClassName, vbNullChar) - 1)
               
            End With
        End If
       
        hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
       
    Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)
   
    Columns("A:B").AutoFit
    Application.ScreenUpdating = True
End Sub
File demo:
 
B

bvtvba

Guest
4.6 Ưu tiên hiển thị cho Window
Để một ứng dụng ưu tiên hiển thị ra ngoài cùng của màn hình, đè lên trên các ứng dụng khác đang hiển thị trên màn hình thì phải làm thế nào?
Chỉ cần trao tham số handler của window application cho hàm SetForegroundWindow, ứng dụng đó (application) sẽ hiển thị ưu tiên ra ngoài cùng của màn hình.
Hãy chú ý rằng SetForegroundWindow được định nghĩa như Sub, không có giá trị trả về. Vì vậy việc sử dụng rất tiện lợi.
Module5:
'Di chuyen vi tri cua window theo truc Z order len top
#If Win64 Then
    Declare PtrSafe Sub SetForegroundWindow Lib "user32" _
            (ByVal hwnd As LongPtr)
#Else
    Declare Sub SetForegroundWindow Lib "user32" _
            (ByVal hwnd As Long)
#End If
Sub SetForegroundWindow_Sample()
    #If Win64 Then
        Dim hwnd As LongPtr
    #Else
        Dim hwnd As Long
    #End If
    hwnd = FindWindow("Notepad", vbNullString)
    
    If hwnd = ERROR_SUCCESS Then
        MsgBox "Notepad chua duoc mo", vbExclamation
        Exit Sub
    End If
    
    SetForegroundWindow hwnd
End Sub
Bạn hãy mở Notepad cùng với đó hãy mở ứng dụng khác chèn lên trên (ví dụ trình duyệt web), sau đó hãy chạy chương trình trên, bạn sẽ thấy ứng dụng Notepad sẽ được di chuyển hiển thị ra ngoài cùng của màn hình.
File demo:
 

Euler

Administrator
Thành viên BQT
4.7 Thực thi chương trình tương ứng với phần mở rộng của file
Mở file với phần mềm tương ứng với phần mở rộng của file

Giả sử chúng ta muốn mở một file .txt, như vậy phần mở rộng của file là .txt, và chúng ta muốn chương trình Notepad thực hiện điều này chứ không phải là chương trình nào khác trên máy tính.
Hàm FindExecutable sẽ lấy tên chương trình tương ứng với phần mở rộng của file. Trong Win API chúng ta có hàm ShellExecute có chức năng tương tự.

Khi sử dụng hàm ShellExecute, chúng ta có thể thực thi chương trình liên quan tới phần mở rộng của file nhưng thực ra thì bằng hàm Shell chúng ta cũng có thể làm điều tương tự.

Chúng ta hãy xem xét ví dụ dưới đây:
Mã:
rc = Shell("Notepad.exe C:\VBA\tuhocvba.txt", vbNormalFocus)
Module0:
#If Win64 Then
    Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As LongPtr, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpPrameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As LongPtr
#Else
    Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpPrameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
#End If
Public Const SW_HIDE = 0&
Public Const SW_MAXIMIZE = 3&
Public Const SW_SHOW = 5&
Public Const SW_MINIMIZE = 6&
Public Const SW_RESTORE = 9&
Public Const SW_SHOWDEFAULT = 10&
Public Const SW_SHOWNORMAL = 1&
Public Const SW_SHOWMINIZED = 2&
Public Const SW_SHOWMAXIMIZED = 3&
Public Const SW_SHOWNOACIVE = 7&
Public Const SW_SHOWNA = 8&

Public Const ERROR_FILE_NOT_FOUND = 2&
Public Const ERROR_PATH_NOT_FOUND = 3&
Public Const ERROR_BAD_FORMAT = 11&

Public Const SE_ERR_FNF = 2&
Public Const SE_ERR_PNF = 3&
Public Const SE_ERR_ACCESSDENIED = 5&
Public Const SE_ERR_OOM = 8&
Public Const SE_ERR_SHARE = 26&
Public Const SE_ERR_ASSOCINCOMPLETE = 27&
Public Const SE_ERR_DDETIMEOUT = 28&
Public Const SE_ERR_DDEFAIL = 29&
Public Const SE_ERR_DDEBUSY = 30&
Public Const SE_ERR_NOASSOC = 31&
Public Const SE_ERR_DLLNOTFOUND = 32&
Module6:
Sub ShellExecute_Sample()
    Dim strClassName    As String 'Class Name
    Dim strPath         As String 'Path name
    
    #If Win64 Then
        Dim hwnd As LongPtr
        Dim rc   As LongPtr
    #Else
        Dim hwnd    As Long
        Dim rc      As Long
    #End If
    
    Dim strOperation    As String 'thao tac thuc thi
    Dim strFile         As String 'File name
    
    strPath = ActiveWorkbook.Path
    
    'Chi dinh Class name
    strClassName = "XLMAIN"
    
    'Lay handle cua Excel
    hwnd = FindWindow(strClassName, Application.Caption)
    
    'Neu la Excel 2002 tro di thi chi can chi dinh tham so = Application.Hwnd
    
    'Thuc thi
    strOperation = "open"
    
    'Chi dinh file name
    strFile = strPath & "\tuhocvba.txt"
    
    'Mo file txt
    rc = ShellExecute(hwnd, strOperation, strFile, vbNullString, vbNullString, SW_SHOWNORMAL)
    'Neu that bai
    If rc <= 31 Then
        Select Case rc
            Case 0&
                MsgBox "Bo nho khong du"
            Case ERROR_FILE_NOT_FOUND
                MsgBox "Khong tim thay file"
            Case ERROR_PATH_NOT_FOUND
                MsgBox "Khong tim thay duong dan"
            Case ERROR_BAD_FORMAT
                MsgBox "File bi vo hieu hoa"
            Case Else
                MsgBox "Loi phat sinh"
        End Select
    End If
    
End Sub
File demo:
(Còn nữa)
 
4.7 Thực thi chương trình tương ứng với phần mở rộng của file
Mở file với phần mềm tương ứng với phần mở rộng của file

(Tiếp theo)
Bình thường, chúng ta muốn in một file Notepad, chúng ta mở file đó lên, vào File => Print.
Trong ví dụ tiếp theo, tôi sẽ trình bày cách thực hiện công việc này bằng VBA API.
Module6:
'In file txt
Sub ShellExecute_Sample2()
    Dim strClassName As String      'Class Name
    Dim strPath         As String   'Path Name
    'handle cua window cha me
    #If Win64 Then
        Dim hwnd    As LongPtr
        Dim rc      As LongPtr
    #Else
        Dim hwnd    As Long
        Dim rc      As Long
    #End If
    
    Dim strOperation As String 'Thao tac thuc thi
    Dim strFile As String 'File name
    
    strPath = ActiveWorkbook.Path
    'Chi dinh Class name
    strClassName = "XLMAIN"
    
    'lay handle window cua Excel
    hwnd = FindWindow(strClassName, Application.Caption)
    'Tu Excel 2002 tro di thi chi can = Application.Hwnd
    
    'Chi dinh thao tac thuc thi
    strOperation = "print" '(1)
    
    'Chi dinh file name
    strFile = strPath & "\tuhocvba.txt"
    
    'Thuc hien in file
    rc = ShellExecute(hwnd, _
                        strOperation, _
                        strFile, _
                        vbNullString, _
                        vbNullString, _
                        SW_HIDE)
    '(1): strOperation
    'Tham so nay co nghia la ta se thuc thi lenh print
    '(2): SW_HIDE
    'Tham so nay co nghia la Notepad khi in, se khong hien thi ra man hinh.
    'Neu ban muon vua hien thi Notepad ra man hinh va thuc hien lenh in, thi su dung tham so la
    'SW_SHOWNORMAL(=1&)
    'Neu that bai:
    If rc <= 31 Then
        Select Case rc
            Case 0&
                MsgBox "Bo nho khong du"
            Case ERROR_FILE_NOT_FOUND
                MsgBox "Khong tim thay file"
            Case ERROR_PATH_NOT_FOUND
                MsgBox "Khong tim thay duong dan"
            Case ERROR_BAD_FORMAT
                MsgBox "File bi vo hieu hoa"
            Case Else
                MsgBox "Da co loi nao do xay ra"
        End Select
    End If
    
End Sub
File demo:
 
4.7 Thực thi chương trình tương ứng với phần mở rộng của file
Mở Folder Explorer

Module 7:
Sub ShekExecute_sample3()
    Dim strClassName    As String 'Class Name
    'handle cua window cha me
    #If Win64 Then
        Dim hwnd    As LongPtr
        Dim rc      As LongPtr
    #Else
        Dim hwnd    As Long
        Dim rc      As Long
    #End If
    
    Dim strOperation    As String 'Thao tac thuc thi
    Dim strFile         As String 'File name
    
    'Chi dinh class name
    strClassName = "XLMAIN"
    
    'Lay handle window Excel
    hwnd = FindWindow(strClassName, Application.Caption)
    'Excel 2002 tro di thi chi can Application.hwnd
    
    'Chi dinh thao thac thuc thi
    strOperation = "explore"
    
    strFile = "C:\Windows"
    
    'Hien thi Explorer
    rc = ShellExecute(hwnd, _
        strOperation, _
        strFile, _
        vbNullString, _
        vbNullString, _
        SW_SHOWNORMAL)
    
    'Neu that bai
    If rc <= 31 Then
        Select Case rc
            Case 0&
                MsgBox "Bo nho khong du"
            Case ERROR_FILE_NOT_FOUND
                MsgBox "Khong tim thay file"
            Case ERROR_PATH_NOT_FOUND
                MsgBox "Khong tim thay duong dan"
            Case ERROR_BAD_FORMAT
                MsgBox "File bi vo hieu"
            Case Else
                MsgBox "Da xay ra loi"
        End Select
    End If
    
    
End Sub
File demo :
 

Euler

Administrator
Thành viên BQT
4.8 Thao tác với DialogBox của File Property
Trong Win API, những hàm làm việc với phần mở rộng của file thường có đuôi Ex. Hàm ShellExecuteEx là một ví dụ.
Ta có thể chỉ định [open], [print], [explore] với hàm ShellExecute nhưng với hàm ShellExecuteEx ta có thể chỉ định [properties] .
Ví dụ, ta có thể mở hộp thoại thuộc tính của file như hình dưới đây.
Bạn cần đăng nhập để thấy hình ảnh


Module0:
'Thanh cong <> 0
'That bai = 0
#If Win64 Then
    Declare PtrSafe Function ShellExecuteEx Lib "shell32.dll" _
    Alias "ShellExecuteExA" _
    (lpExeInfo As SHELLEXECUTEINFO) As LongPtr
#Else
'    Declare Function ShellExecuteEx Lib "shell32.dll" _
'    Alias "ShellExecuteExA" _
'    (lpExeInfo As SHELLEXECUTEINFO) As Long
#End If
Type SHELLEXECUTEINFO
    cbSize  As Long 'so byte
    fMask   As Long 'chi dinh kich hoat
    #If Win64 Then
        hwnd    As LongPtr 'handle cua window cha me
    #Else
        hwnd    As Long 'handle cua window cha me
    #End If
    lpVerb  As String 'thao tac thuc thi
    lpFile  As String 'file name
    lpParameters    As String 'parameter trao cho application
    lpDirectory     As String 'List danh sach thao tac
    nShow           As Long 'flag chi dinh phuong phap hien thi
    hInstApp        As Long 'buffer tiep nhan tu ket qua thuc thi
    lpIDList        As Long
    lpClass         As String
    hkeyClass       As Long
    dwHotKey        As Long
    hIcon           As Long
    hProcess        As Long
    
    
End Type

Public Const SEE_MASK_CLASSNAME = &H1&
Public Const SEE_MASK_CLASSKEY = &H3&
Public Const SEE_MASK_IDLIST = &H4&
Public Const SEE_MASK_INVOKEIDLIST = &HC&
Public Const SEE_MASK_ICON = &H10&
Public Const SEE_MASK_HOTKEY = &H20&
Public Const SEE_MASK_NOCLOSEPROCESS = &H40&
Public Const SEE_MASK_CONNECTNETDRV = &H80&
Public Const SEE_MASK_FLAG_DDEWAIT = &H100&
Public Const SEE_MASK_DOENVSUBST = &H200&
Public Const SEE_MASK_FLAG_NO_UI = &H400&
Module 8:
Sub ShellExecuteEx_Sample()
    Dim udtSHELLEXECUTEINFO As SHELLEXECUTEINFO
    Dim strClassName        As String 'Class Name
    #If Win64 Then
        Dim hwnd                As LongPtr
        Dim rc                  As LongPtr
    #Else
        Dim hwnd                As Long
        Dim rc                  As Long
    #End If
    
    'Chi dinh class name
    strClassName = "XLMAIN"
    
    'Lay handle window excel
    hwnd = FindWindow(strClassName, Application.Caption)
    'Excel 2002 tro di = Application.hwnd cung duoc
    
    With udtSHELLEXECUTEINFO
        .cbSize = Len(udtSHELLEXECUTEINFO)
        .fMask = SEE_MASK_INVOKEIDLIST Or SEE_MASK_NOCLOSEPROCESS _
                Or SEE_MASK_FLAG_NO_UI
        .hwnd = hwnd
        .lpVerb = "properties"
        'tuy thuoc vao may tinh ma duong link sau co the khac nhau, ban hay sua lai cho phu hop
        .lpFile = "C:\Windows\System32\Notepad.exe"
        .lpParameters = vbNullString
        .lpDirectory = vbNullString
        .nShow = 0&
        .hInstApp = 0&
        .lpIDList = 0&
        
    End With
    
        rc = ShellExecuteEx(udtSHELLEXECUTEINFO)
End Sub
File demo:
 
<tiếp theo 4.8>
Shutdown bằng Win API
Khi sử dụng hàm ExitWindowsEx của Win API, chúng ta có thể thực hiện Logoff, Shutdown, hay Restart... Tuy nhiên, việc này khá nguy hiểm bởi tùy phiên bản Windows mà tính hiệu quả khác nhau. Nếu có hứng thú đối với vấn đề này, các bạn hãy tìm hiểu thêm nhé. Ở đây tôi đưa ra một chương trình mẫu ví dụ.
Mã:
#If Win64 Then
Declare PtrSafe Function ExitWindowsEx Lib "user32" _
    (ByVal uFlags As Long, _
    ByVal dwReserved As Long) As LongPtr
#Else
Declare Function ExitWindowsEx Lib "user32" _
    (ByVal uFlags As Long, _
    ByVal dwReserved As Long) As Long
#End If

Public Const EWX_LOGOFF = 0& 'Logoff
Public Const EWX_SHUTDOWN = 1& 'Shutdown
Public Const EWX_REBOOT = 2& 'Restart
Public Const EWX_FORCE = 4& 'Cuong che chuong trinh ket thuc
Public Const EWX_POWEROFF = 8& 'sau khi shutdown thi tat nguon

Sub ExitWindowsEx_Sample()
    #If Win64 Then
        Dim rc As LongPtr
    #Else
        Dim rc As Long
    #End If
    'Thuc hien viec shutdown
    rc = ExitWindowsEx(EWX_SHUTDOWN, _
                        0&)
    
End Sub
 
Top