#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Private Function WaitAndActivate(ByVal titleHint As String, ByVal timeoutMs As Long) As Boolean
Dim startT As Single
startT = Timer
Do While (Timer - startT) * 1000 < timeoutMs
On Error Resume Next
AppActivate titleHint
If Err.Number = 0 Then
On Error GoTo 0
WaitAndActivate = True
Exit Function
End If
Err.Clear
On Error GoTo 0
Sleep 200
Loop
WaitAndActivate = False
End Function
Sub AutoPrint_FB03_Final()
Const PRINT_TITLE As String = "Print"
Const PROPS_TITLE As String = "DocuCentre"
Const USE_PROPERTIES As Boolean = True
Dim SAP_app As Object, connection As Object, session As Object
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim docNumber As String
Dim compCode As String, fiscalYear As String
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
On Error Resume Next
Set SAP_app = GetObject("SAPGUI").GetScriptingEngine
If SAP_app Is Nothing Then
MsgBox "Không tìm thấy SAP. Vui lòng mở và đăng nhập SAP trước khi chạy lệnh!", vbCritical
Exit Sub
End If
On Error GoTo 0
Set connection = SAP_app.Children(0)
Set session = connection.Children(0)
Set ws = ThisWorkbook.Sheets("Sheet1")
compCode = ws.Range("D2").Value
fiscalYear = ws.Range("E2").Value
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
session.findById("wnd[0]/tbar[0]/okcd").Text = "/nFB03"
session.findById("wnd[0]").sendVKey 0
For i = 2 To lastRow
docNumber = Format(ws.Cells(i, 1).Value, "0000000000")
If docNumber <> "0000000000" And ws.Cells(i, 2).Value <> "Đã in" Then
On Error GoTo ErrorHandler
session.findById("wnd[0]/usr/txtRF05L-BELNR").Text = docNumber
session.findById("wnd[0]/usr/ctxtRF05L-BUKRS").Text = compCode
session.findById("wnd[0]/usr/txtRF05L-GJAHR").Text = fiscalYear
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/mbar/menu[0]/menu[5]").Select
session.findById("wnd[0]/mbar/menu[0]/menu[0]").Select
session.findById("wnd[1]/usr/ctxtPRI_PARAMS-PDEST").Text = "LP01"
session.findById("wnd[1]/usr/radRADIO0500_2").Select
session.findById("wnd[2]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/txtPRIPAR_DYN-SPOOLPAGE1").Text = "2"
session.findById("wnd[1]/usr/txtPRIPAR_DYN-SPOOLPAGE2").Text = "2"
session.findById("wnd[1]/usr/subSUBSCREEN:SAPLSPRI:0600/cmbPRIPAR_DYN-PRIMM2").Key = "X"
session.findById("wnd[1]/tbar[0]/btn[13]").SetFocus
session.findById("wnd[1]/tbar[0]/btn[13]").press
If Not WaitAndActivate(PRINT_TITLE, 10000) Then
Err.Raise 9999, , "Không tìm thấy cửa sổ Print sau 10 giây"
End If
Sleep 500
If USE_PROPERTIES Then
WshShell.SendKeys "{TAB}", True
Sleep 300
WshShell.SendKeys "{ENTER}", True
If Not WaitAndActivate(PROPS_TITLE, 8000) Then
Err.Raise 9999, , "Không mở được cửa sổ Properties"
End If
Sleep 900
If Not WaitAndActivate(PROPS_TITLE, 2000) Then
Err.Raise 9999, , "Mất focus cửa sổ Properties"
End If
WshShell.SendKeys "{TAB 5}", True
Sleep 600
WshShell.SendKeys "{DOWN 5}", True
Sleep 900
WshShell.SendKeys "{ENTER}", True
Sleep 900
WaitAndActivate PRINT_TITLE, 8000
Sleep 500
WshShell.SendKeys "{ENTER}", True
Else
WshShell.SendKeys "{ENTER}", True
End If
Sleep 1500
session.findById("wnd[0]/tbar[0]/btn[3]").press
ws.Cells(i, 2).Value = "Đã in"
SkipToNext:
End If
Next i
MsgBox "Print completed!", vbInformation
Exit Sub
ErrorHandler:
ws.Cells(i, 2).Value = "Error Print"
On Error Resume Next
session.findById("wnd[0]/tbar[0]/btn[3]").press
On Error GoTo 0
Resume SkipToNext
End Sub
