PrintScript:Outlook

PrintScript:Outlook

Sub PrintEmailWithoutTheHeader(olkMsg As Outlook.MailItem)
    Const OLECMDID_PRINT = 6
    Const OLECMDEXECOPT_DONTPROMPTUSER = 2
    Dim objIE As Object, strHead As String, strFoot As String
    strHead = GetIEHeaderFooter("header")
    strFoot = GetIEHeaderFooter("footer")
    SetIEHeaderFooter "header", ""
    SetIEHeaderFooter "footer", ""
    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
        .Navigate2 "about:blank"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        .Document.Title = olkMsg.Subject
        .Document.Body.innerHTML = olkMsg.HTMLBody
        .ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, 2, vbNull
    End With
    SetIEHeaderFooter "header", strHead
    SetIEHeaderFooter "footer", strFoot
    objIE.Quit
    Set olkMsg = Nothing
    Set objIE = Nothing
End Sub
  
Function GetIEHeaderFooter(strType As String) As String
    Dim objShl As Object
    Select Case LCase(strType)
        Case "footer", "header"
            Set objShl = CreateObject("WScript.Shell")
            GetIEHeaderFooter = objShl.RegRead("HKCU\Software\Microsoft\Internet Explorer\PageSetup\" & LCase(strType))
    End Select
    Set objShl = Nothing
End Function
  
Sub SetIEHeaderFooter(strType As String, strVal As String)
    Dim objShl As Object
    Select Case LCase(strType)
        Case "footer", "header"
            Set objShl = CreateObject("WScript.Shell")
            objShl.RegWrite "HKCU\Software\Microsoft\Internet Explorer\PageSetup\" & LCase(strType), strVal, "REG_SZ"
    End Select
    Set objShl = Nothing
End Sub