Solved: Need help to auto open html file, print and close

[Maby]

Hi,

What i'm essentially trying to do is auto print html attachments from Outlook. I have found some code to auto save and print XLS files, and have successfully tweeked the auto save part to save html files. What I can't seem to figure out is how to then have the file open in internet explorer and auto print.

Any help would be greatly appreciated. Below is what I have so far:

'########################################################################## #####
'### Module level Declarations
'expose the items in the target folder to events
Option Explicit
Dim WithEvents TargetFolderItems As Items
'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\Temp\"

'########################################################################## #####
'### this is the Application_Startup event code in the ThisOutlookSession module
Private Sub Application_Startup()
'some startup code to set our "event-sensitive" items collection
Dim ns As Outlook.NameSpace
'
Set ns = Application.GetNamespace("MAPI")
Set TargetFolderItems = ns.Folders.Item( _
"Mailbox - Ben Mabee").Folders.Item("Speech Orders Fulfilled").Items

End Sub

'########################################################################## #####
'### this is the ItemAdd event code
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
'when a new item is added to our "watched folder" we can process it
Dim olAtt As Attachment
Dim i As Integer

If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
'save the attachment
If UCase(Right(olAtt.FileName, 4)) = "html" Then
olAtt.SaveAsFile FILE_PATH & olAtt.FileName
End If


'if its an HTML file, pass the filepath to the print routine
If UCase(Right(olAtt.FileName, 4)) = "html" Then
PrintAtt (FILE_PATH & olAtt.FileName)

End If
Next
End If

Set olAtt = Nothing

End Sub
'########################################################################## #####
'### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()

Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing

End Sub

[Oorang]

Make sure you read the comments.

Option Explicit
Const m_strModuleName_c As String = "PrettyPrint"
Public Function PrintHTML(filePath As String, Optional visibleBrowser As Boolean = False) As Boolean
'-------------------------------------------------------------------------------
' Procedure : PrintHTML
' DateTime : 12/31/2007 12:53 PM 12:53
' Author : Aaron Bush
' Purpose : To print a html file.
' Input(s) : filePath - The path to the file you wish to print.
' Output(s) : True - No error encountered.
' False - Error found.
' Remarks : Free for public use.
' Requires reference to Microsoft Internet Controls. to set a
' reference, go to Tool, References, and select
' "Microsoft Internet Controls". If library is not present then
' click "browse" and browse to C:\Windows\System32\shdocvw.dll.
'-------------------------------------------------------------------------------
Dim objIE As SHDocVw.InternetExplorer
On Error GoTo Err_Hnd
'Instantiate a instance of Internet Explorer:
Set objIE = New SHDocVw.InternetExplorer
'Set visibility:
objIE.Visible = visibleBrowser
'Load specified file:
objIE.Navigate filePath
'Wait for file to load:
Do Until objIE.ReadyState = READYSTATE_COMPLETE
Loop
'Print:
objIE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER
'Flag as error free:
PrintHTML = True
Exit_Proc:
On Error Resume Next
'Close browser:
objIE.Quit
Exit Function
Err_Hnd:
VBA.MsgBox "Error " & VBA.Err.Number & " in procedure PrintHTML of Module" & m_strModuleName_c & vbNewLine & VBA.Err.Description, vbMsgBoxSetForeground Or vbSystemModal, "Error - " & m_strModuleName_c & ".PrintHTML"
Resume Exit_Proc
End Function

[Maby]

Thank you so much for the help. I have successfully tweaked the code to work...the only problem is that it only works if I tell it to give me a msgbox after the print command. Any idea why, or how I can streamline it so the msgbox is not necessary?

Without the msgbox command present I get a script error box, one of the error messages that asks if I want to continue running scripts, yes/no...

[Oorang]

I am unable to reproduce the error. Can you post the error message, also what line of code are you hitting it at?

[Maby]

Hi,

As requested...below I have posted the code differences and error messages... I'll try to be as clear as possible, but let me know if I can further detail anything.

The first section of code works as desired with auto save and print of html files. I have bolded the portion of code that is different amongst the examples. In this first case, a message box pops up telling me the path of the file being sent to the printer. Just after the message box pops up the file gets sent to the printer. If I hit 'ok' on the message box it will go on to save and print the next file, and so on.

Because the only code i'm changing is in the last section of code, I will just duplicate that portion after example one, but the top portion is present in all 3 cases.

At the top of example 2 below is the error message I receive when I try to delay the program by 1000ms. It still performs as it should, and sends the job to the printer just after popping up the error message.

Example 3 below describes what happens when I take the line out completely.

I have also attached screen shots of the 2 error messages for reference.

Thanks again, and let me know what you think when you get a chance.

-Ben





1) '########################################################################## #####
'### Module level Declarations
'expose the items in the target folder to events

Dim WithEvents TargetFolderItems As Items
'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\Temp\"


'########################################################################## #####
'### this is the Application_Startup event code in the ThisOutlookSession module
Private Sub Application_Startup()
'some startup code to set our "event-sensitive" items collection
Dim ns As Outlook.NameSpace
'
Set ns = Application.GetNamespace("MAPI")
Set TargetFolderItems = ns.Folders.Item( _
"Mailbox - Ben Mabee").Folders.Item("Speech Orders Fulfilled").Items

End Sub

'########################################################################## #####
'### this is the ItemAdd event code
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
'when a new item is added to our "watched folder" we can process it
Dim olAtt As Attachment
Dim i As Integer

If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
'save the attachment
If LCase(Right(olAtt.FileName, 4)) = "html" Then
olAtt.SaveAsFile FILE_PATH & olAtt.FileName
End If


'if its an HTML file, pass the filepath to the print routine
If LCase(Right(olAtt.FileName, 4)) = "html" Then
PrintAtt (FILE_PATH & olAtt.FileName)

End If
Next
End If

Set olAtt = Nothing

End Sub


'########################################################################## #####
'### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()

Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing

End Sub
Public Function PrintAtt(fFullPath As String, Optional visibleBrowser As Boolean = False) As Boolean
Const m_strModuleName_c As String = "PrettyPrint"
'-------------------------------------------------------------------------------
' Procedure : PrintHTML
' DateTime : 12/31/2007 12:53 PM 12:53
' Author : Aaron Bush
' Purpose : To print a html file.
' Input(s) : filePath - The path to the file you wish to print.
' Output(s) : True - No error encountered.
' False - Error found.
' Remarks : Free for public use.
' Requires reference to Microsoft Internet Controls. to set a
' reference, go to Tool, References, and select
' "Microsoft Internet Controls". If library is not present then
' click "browse" and browse to C:\Windows\System32\shdocvw.dll.
'-------------------------------------------------------------------------------
Dim objIE As SHDocVw.InternetExplorer
On Error GoTo Err_Hnd
'Instantiate a instance of Internet Explorer:
Set objIE = New SHDocVw.InternetExplorer
'Set visibility:
objIE.Visible = visibleBrowser
'Load specified file:
objIE.Navigate fFullPath
'Wait for file to load:
Do Until objIE.readyState = READYSTATE_COMPLETE
Loop
'Print:
objIE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER
'Flag as error free:
PrintAtt = True
MsgBox fFullPath

Exit_Proc:
On Error Resume Next
'Close browser:
objIE.Quit
Exit Function
Err_Hnd:
VBA.MsgBox "Error " & VBA.Err.Number & " in procedure PrintAtt of Module" & m_strModuleName_c & vbNewLine & VBA.Err.Description, vbMsgBoxSetForeground Or vbSystemModal, "Error - " & m_strModuleName_c & ".PrintAtt"
Resume Exit_Proc
End Function


2)

"Error - PrettyPrint.PrintAtt"

"Error 424 in procedure PrintAtt of ModulePrettyPrint
Object required"

Public Function PrintAtt(fFullPath As String, Optional visibleBrowser As Boolean = False) As Boolean
Const m_strModuleName_c As String = "PrettyPrint"
'-------------------------------------------------------------------------------
' Procedure : PrintHTML
' DateTime : 12/31/2007 12:53 PM 12:53
' Author : Aaron Bush
' Purpose : To print a html file.
' Input(s) : filePath - The path to the file you wish to print.
' Output(s) : True - No error encountered.
' False - Error found.
' Remarks : Free for public use.
' Requires reference to Microsoft Internet Controls. to set a
' reference, go to Tool, References, and select
' "Microsoft Internet Controls". If library is not present then
' click "browse" and browse to C:\Windows\System32\shdocvw.dll.
'-------------------------------------------------------------------------------
Dim objIE As SHDocVw.InternetExplorer
On Error GoTo Err_Hnd
'Instantiate a instance of Internet Explorer:
Set objIE = New SHDocVw.InternetExplorer
'Set visibility:
objIE.Visible = visibleBrowser
'Load specified file:
objIE.Navigate fFullPath
'Wait for file to load:
Do Until objIE.readyState = READYSTATE_COMPLETE
Loop
'Print:
objIE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER
'Flag as error free:
PrintAtt = True
wscript.sleep 1000

Exit_Proc:
On Error Resume Next
'Close browser:
objIE.Quit
Exit Function
Err_Hnd:
VBA.MsgBox "Error " & VBA.Err.Number & " in procedure PrintAtt of Module" & m_strModuleName_c & vbNewLine & VBA.Err.Description, vbMsgBoxSetForeground Or vbSystemModal, "Error - " & m_strModuleName_c & ".PrintAtt"
Resume Exit_Proc
End Function

3)

I get an 'Internet Explorer Script Error', Line: 228, Char: 1, Error: 'dialogArguments.__IE_PrintType' is null or not an object, Code: 0, URL: res://C:\WINDOWS\system32\shdoclc.dll/preview.dlg...And it asks, 'Do you want to continue running scripts on this page? Yes/No'

Public Function PrintAtt(fFullPath As String, Optional visibleBrowser As Boolean = False) As Boolean
Const m_strModuleName_c As String = "PrettyPrint"
'-------------------------------------------------------------------------------
' Procedure : PrintHTML
' DateTime : 12/31/2007 12:53 PM 12:53
' Author : Aaron Bush
' Purpose : To print a html file.
' Input(s) : filePath - The path to the file you wish to print.
' Output(s) : True - No error encountered.
' False - Error found.
' Remarks : Free for public use.
' Requires reference to Microsoft Internet Controls. to set a
' reference, go to Tool, References, and select
' "Microsoft Internet Controls". If library is not present then
' click "browse" and browse to C:\Windows\System32\shdocvw.dll.
'-------------------------------------------------------------------------------
Dim objIE As SHDocVw.InternetExplorer
On Error GoTo Err_Hnd
'Instantiate a instance of Internet Explorer:
Set objIE = New SHDocVw.InternetExplorer
'Set visibility:
objIE.Visible = visibleBrowser
'Load specified file:
objIE.Navigate fFullPath
'Wait for file to load:
Do Until objIE.readyState = READYSTATE_COMPLETE
Loop
'Print:
objIE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER
'Flag as error free:
PrintAtt = True

Exit_Proc:
On Error Resume Next
'Close browser:
objIE.Quit
Exit Function
Err_Hnd:
VBA.MsgBox "Error " & VBA.Err.Number & " in procedure PrintAtt of Module" & m_strModuleName_c & vbNewLine & VBA.Err.Description, vbMsgBoxSetForeground Or vbSystemModal, "Error - " & m_strModuleName_c & ".PrintAtt"
Resume Exit_Proc
End Function

[Oorang]

Well I am just guessing here, because I can't reproduce your problem.

But if it appears to be a wait issue I can offer a few remarks:
In example 2 if I had to guess, I would say your issue is with the wscript.sleep command. It looks like you forgot to instantiate or declare the object, so when it executes, wscript is nothing. Try fixing that and sleeping it for a second or two before you print. Also make sure that you have a default printer set.

Another approach is to just make it wait until it prints. It's not elegant but it works:
Dim lngSanityCheck As Long
Const lngOffset_c As Long = 1
Const lngErrFree_c As Long = 0
Const lngMaxCheck_c As Long = 2147483647
On Error Resume Next
Do
lngSanityCheck = lngSanityCheck + lngOffset_c
objIE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER
If VBA.Err.Number = lngErrFree_c Then
Exit Do
ElseIf lngSanityCheck = lngMaxCheck_c Then
'Error is already raised, send to error handler to display.
GoTo Err_Hnd
End If
Loop
On Error GoTo Err_Hnd

[Maby]

Much Appreciation! Your approach worked, and it is now fuctioning as I wanted it to; auto saves and prints perfectly!

Thank you for all your help,

-Ben

[Oorang]

Awesome! I love it when I fix a problem I don't understand! :blush:haha:

Seriously though I have long since noticed that IE will change it's readystate to complete when it's not quite complete for everything. I suspect this is a facet of that. I have had to use this solution before when loading the document property into a MSHTML document object and you basicly end up looping until it is not nothing. If you use the the ShDocVw Library a lot, you will want to watch that problem.