Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
Private Sub PrintEmailBodyAndAttachments()
Dim objMail As Outlook.MailItem
Dim objSel As Outlook.Selection
Dim objAtt As Outlook.Attachment
Dim i As LongPtr, j As LongPtr, lngNumAtt As LongPtr
Dim strAttFilePath As String
i = 1
SetDefaultPrinter "Tên máy in"
Set objSel = Application.ActiveExplorer.Selection
For i = 1 To objSel.Count
If TypeOf objSel.Item(i) Is Outlook.MailItem Then
Set objMail = objSel.Item(i)
With objMail
.PrintOut
If .Attachments.Count > 0 Then
For j = 1 To .Attachments.Count
Set objAtt = .Attachments.Item(j)
strAttFilePath = Environ$("TEMP") & "\" & objAtt.FileName
objAtt.SaveAsFile strAttFilePath
Select Case GetFileExtension(strAttFilePath)
Case ".xls", ".xlsm", ".xlsb", ".xlsx", ".doc", ".docx", ".docm", ".pdf"
ShellExecute 0, "print", strAttFilePath, vbNullString, vbNullString, 0
End Select
DeleteFile strAttFilePath
Next
End If
End With
End If
Next
Set objMail = Nothing
Set objSel = Nothing
Set objAtt = Nothing
End Sub
Private Sub SetDefaultPrinter(PrinterName As String, Optional ComputerName As String = ".")
Dim Printer As Object, Printers As Object, WMIService As Object
Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2")
Set Printers = WMIService.ExecQuery("Select * from Win32_Printer Where Name = '" & PrinterName & "'")
For Each Printer In Printers
Printer.SetDefaultPrinter
Next
Set Printer = Nothing
Set Printers = Nothing
Set WMIService = Nothing
End Sub
Private Function GetFileExtension(FileName As String) As String
On Error Resume Next
GetFileExtension = Mid(FileName, InStrRev(FileName, "."))
If Err.Number = 5 Then
GetFileExtension = vbNullString
End If
End Function