locked
VBA script to print custom outlook form RRS feed

  • Question

  • i have a custom outlook form that i would like to print from a command button on the form. i found some code doing a search which prints the form fine but you need to copy to the clip board (alt + prt screen) first. i would like to automate that into the script. i understand that you can not use the sendkeys "alt + print screen". i did find some other code which seems to work if i put in a module and run as a macro but can not seem to get it to work in the script.

     

    here is the script:

     

    Sub cmdPrint_Click()

    Set oWordApp = CreateObject("Word.Application")

    If oWordApp Is Nothing Then

    MsgBox "Couldn't start Word."

    Else

    '

    ' capture screen image

     

    ' Open a new document

    Set oDoc = oWordApp.Documents.Add

    ' Set a page setup object variable

    Set oPS = oDoc.PageSetup

    ' Reduce the margins to .5" (36 points)

    oPS.TopMargin = 36

    oPS.BottomMargin = 36

    oPS.LeftMargin = 36

    oPS.RightMargin = 36

    ' Paste in the screen shot

    oWordApp.Selection.Paste

    ' Center the screen shot

    Const wdAlignParagraphCenter = 1

    oDoc.Paragraphs(1).Alignment=wdAlignParagraphCenter

    ' Get the current Word setting for background printing

    bolPrintBackground = oWordApp.Options.PrintBackground

    ' Turn background printing off

    oWordApp.Options.PrintBackground = False

    ' Print the Word document

    oDoc.PrintOut

    ' Restore previous setting

    oWordApp.Options.PrintBackground = bolPrintBackground

    ' Close and don't save changes to the document

    Const wdDoNotSaveChanges = 0

    oDoc.Close wdDoNotSaveChanges

    ' Close the Word instance

    oWordApp.Quit

    ' Clean up

    Set oPS = Nothing

    Set oDoc = Nothing

    Set oWordApp = Nothing

    End If

    End Sub

     

     

    here is the code in the macro:

     

    Option Explicit
    Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Const KEYEVENTF_KEYUP = &H2
    Private Const VK_SNAPSHOT = &H2C
    Private Const VK_MENU = &H12

    Sub ScreenCapture()
    Dim Sec3 As Date
    Sec3 = DateAdd("s", 2, Now)
    Do Until Now > Sec3
    DoEvents
    Loop
     keybd_event VK_MENU, 0, 0, 0
     keybd_event VK_SNAPSHOT, 0, 0, 0
     keybd_event VK_SNAPSHOT, KEYEVENTF_KEYUP, 0, 0
     keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
    End Sub

     

     

    any ideas how to get this to work? any help is greatly appreciated.

     

     

    • Moved by Bill_Stewart Monday, December 12, 2011 5:34 PM Move to more appropriate forum (From:The Official Scripting Guys Forum!)
    Monday, December 12, 2011 2:10 PM

Answers

  • Hi tarichter1,

     

    Thanks for posting in the MSDN Forum.

     

    Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Const KEYEVENTF_KEYUP = &H2
    Private Const VK_SNAPSHOT = &H2C
    Private Const VK_MENU = &H12
    
    

     

    This snippet must be written at the beginning of the module. It's works fine on my side. I hope you are able to try it. If you have any questions please feel free to let me know.

    Have a good day,

     

    Tom


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us

     
    Wednesday, December 14, 2011 3:15 AM