Printing Attachments and DoEvents

Greetings. I'm new to this forum, so I thought I'd start out with a doozy.

The Project: I've been attempting to create a VBA Outlook macro that, when executed, prints every message in a dedicated folder. This macro is part of a process I'm developing to convert emails and attachments to multipage TIF images, working largely in conjunction with Zan Image Printer software to append each print job to a temp.tif file, which the script copies and deletes when all attachments from a MailItem have been completed. The script also creates a text file containing account numbers extracted from the Subject line, and it changes printer settings (by swapping INI files) from B&W to grayscale if it detects any JPG/GIF/etc attachments, the message is flagged, or it contains the word "picture" in the subject line.

The Problem: I have a While loop that pauses batch processing until a file named "sentinel.txt" is generated in the filesystem, signifying that the printer has completed a job. This loop hogs the processor while the printer is working and attachments are being opened by their default programs, slowing the process significantly and prompting unwanted popups from programs like MS Word asking if the user would like to cancel the process because it's taking too long. I tried to solve this by placing the DoEvents function within the loop, but now the printer randomly finishes a job and starts the next one within a single DoEvents window, creating and deleting the sentinel file before my loop even knows it was ever there. This throws off the running count of printed attachments in the code, causing TIF files to be spliced across MailItems and B&W/grayscale printer settings to change unexpectedly.

TCode]
' Send message and all attachments to the printer
itm.PrintOut
' Wait for sentinel file to be regenerated for each print job
For i = 1 To itm.Attachments.count + 1
While Not fs.FileExists(strProgramPath & "\sentinel.txt")
DoEvents ' Without this line, program is slow. With it, program is unreliable.
Wend
' Delete file now that we know it's there. Otherwise, next loop might exit
' before printer has been able to start its next job and delete it again.
fs.DeleteFile (strProgramPath & "\sentinel.txt")
Next
[/Code]

The Questions:

1. Is there a way to print each attachment individually (I won't always know what it is) rather than using Outlook VBA's PrintOut method with default print settings to print each attachment?
2. Is there a way in VBA, with or without DoEvents, to handle the multitasking better so the script isn't hogging the processor but it still won't miss the sentinel file generation?
3. Are there any other ways I might approach this project?

Thanks in advance for comments and suggestions. Any insight to this project would be great!

P.S. As I typed this, another idea came to me. The printer software has the option of running a command or application after completing a job, which I've used to append text to a time-stamped log so I could compare against my script's log and doublecheck the missed sentinel files. But I could feasibly set the printer to append a new line to a specified data file. Then my script could read this file at timed intervals in another DoEvents loop, count the number of lines in the file, and proceed with the program when "# of lines = # of attachments + 1". This way, the file is always there, and I can let the script delete it when it's satisfied all attachments have been printed. I may give this a try.

You might want to give the sleep-API a try. With it, you can pause your program for a certain amount of time (let's say 1000 ms) and the look for the file again.
So it would be something like that:

Code:

---

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 [...]
For i = 1 To itm.Attachments.Count + 1
    While Not fs.FileExists(strProgramPath & "\sentinel.txt")
        Sleep 1000
    Wend
    ' Delete file now that we know it's there. Otherwise, next loop might exit
    ' before printer has been able to start its next job and delete it again.
    fs.DeleteFile (strProgramPath & "\sentinel.txt")
Next

---

Daniel

I've always wondered how to use the Sleep function in VBA, and now I know. Thanks!

Per my new idea yesterday, I tried a different method of tracking the number of completed print jobs. First, I configured my printer driver to execute echo 1 >> \programpath\prtjb.dat after each print job (and each attachment is a separate print job), creating a data file with a line for each job. Then I replaced my sentinel loop with the following code (which I might now try modifying with the Sleep function instead of using a Timer):

Code:

---

c = Timer()
Do
    p = 0
    DoEvents
    If Timer() > c + 2 Then
        c = Timer()
        ' Count number of lines in prtjb file
        If fs.FileExists(strProgramPath & "\prtjb.dat") Then
            Set ts = fs.OpenTextFile(strProgramPath & "\prtjb.dat", 1)
            Do
                ts.ReadLine
                p = p + 1
            Loop Until ts.AtEndOfStream
            ts.Close
        End If
    End If
Loop Until p = itm.Attachments.count + 1
fs.DeleteFile (strProgramPath & "\prtjb.dat")

---

This appears to have worked perfectly in catching what's been printed. I did run into another problem when I tested this against larger batches (only 6 items in a folder, but several grayscale pictures). Somehow, a random jpg attachment kept dropping without any logged errors, causing my loop to wait indefinately for another line in the data file that will never appear. However, I switched default image viewer associations and this seems to have fixed it.

Now that my script is functional once again, I need to see if I can bring some semblance of order to it. The printout method for Outlook is inflexible, unfriendly, and unpredictable. Because it prints the message and all attachments simultaneously, there's no telling which order the images will retain when the final TIF file is completed. I would at least like to see the message body reliably displayed as the first page, but this doesn't seem possible.

Are there any methods to print a singled attached file from its default application? If I could control the printing order, it would organize the images and even make the above loop completely unnecessary (I could just go back to my sentinel loop without worrying about the next print job starting before I tell it to).

I'm giving this another bump, since I feel I've half-stumbled upon the path to the answer.

As I found out the hard way when installing this macro on another machine, each file extension in Windows has specific actions configured to its associations (as found in File Types tab of Tools/Folder Options menu from any explorer window). The default action is usually open, which calls the associated program to open the file when you double-click the filename from a windows explorer. Another such action is print, and it appears that Outlook VBA's PrintOut method calls this specific action on each file attached to an email (as Outlook refused to print JPG files until I specifically added this action).

Here's the challenge: How can I access a filetype's print action directly from VBA? If I knew this answer, I could code a PrintAttachment function that bypasses Outlook's limited PrintOut method. Also, if I could somehow determine if a filetype does not have this action available, the function could return False (or Raise an error) and allow my macro to run its own error processing within my batch of printing instead of having Outlook generate a popup in the middle of my macro explaining the problem (which, unfortunately, is not avoided by an On Error statement).

Any experts have this answer? I'll post again if I manage to find it myself.

I think I've got it. The answer lies in the ShellExecute API function, along with some rummaging through the FolderItemVerbs shell object, where these associated commands (called "verbs" by Microsoft, apparantly) are stored. So here's the method I've developed for printing attachments:

Code:

---

Option Explicit

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
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
 
Public Function printAttachment(ByRef atm As Attachment) As Boolean
    ' Runs print command on associated file. Returns False if file cannot be printed.
    On Error GoTo ErrorHandler
    Dim tempFilePath As String, tempDir As String, i As Integer, fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    ' Get temp directory
    tempDir = GetTempDirectory
    ' Ensure another temporary file is not replaced
    Do
        i = i + 1
        tempFilePath = tempDir & i & atm.FileName
    Loop While fs.fileExists(tempFilePath)
    Debug.Print "FilePath: " & tempFilePath
    ' Save temporary file
    atm.SaveAsFile tempFilePath
    ' Check file for print verb. Print if found, then delete temp file and exit function
    Dim v, verbs As Variant
    verbs = GetFileVerbs(tempFilePath)
    For Each v In verbs
        If v = "&Print" Then
            ShellExecute 0, "print", tempFilePath, "", tempDir, 0
            fs.DeleteFile tempFilePath, True
            printAttachment = True
            Exit Function
        End If
    Next
    ' File is not printable. Delete temp file and return false
    printAttachment = False
    fs.DeleteFile tempFilePath, True
    Exit Function
    ' Something went wrong; return false
    ErrorHandler:
    If fs.fileExists(tempFilePath) Then fs.DeleteFile (tempFilePath)
    printAttachment = False
End Function
 
Public Function GetTempDirectory() As String
    ' Borrowed from http://www.developerfusion.co.uk/show/2561/4/
    Dim s As String
    Dim c As Long
    s = Space$(MAX_LENGTH)
    c = GetTempPath(MAX_LENGTH, s)
    If c > 0 Then
        If c > Len(s) Then
            s = Space$(c + 1)
            c = GetTempPath(MAX_LENGTH, s)
        End If
    End If
    GetTempDirectory = IIf(c > 0, Left$(s, c), "")
End Function
 
Public Function GetFileVerbs(FilePath As String) As Variant
    ' Returns string array of verb names
    Dim sh As Object, folder1 As Object, file1 As Object, verbcol As Object, i As Integer
    Set sh = CreateObject("Shell.Application")
    For i = Len(FilePath) To 1 Step -1
        If Mid(FilePath, i, 1) = "" Then
            Set folder1 = sh.NameSpace(Left(FilePath, i - 1))
            Exit For
        End If
    Next
    Set file1 = folder1.ParseName(Mid(FilePath, i + 1))
    Set verbcol = file1.verbs
    Dim verbStrings() As Variant, v As Object
    ReDim verbStrings(verbcol.count - 1)
    For i = 0 To verbcol.count - 1
        Set v = verbcol.Item(i + 1)
        verbStrings(i) = v.Name
    Next
    GetFileVerbs = verbStrings
End Function

---

Some things I noted about this process:

• As mentioned before, this utilizes the print "verb" as configured for a file extension in the File Types tab of the Folder Options window. That process is also called by right-clicking a file and selecting Print from the shortcut menu, which is an easy way to test it. I also wrote the GetFileVerbs function to return a list of available verb names, which might be useful if you ever have to experiment with additional verb commands.
• The FolderItemVerb shell object has a DoIt method which could have been used instead of the ShellExecute function. However, ShellExecute seems to wait for the file to be sent to the printer before continuing code execution -- which is important since the next step involves deleting the temporary file. Using the DoIt method caused the file to be deleted before the default application could load it. Then again, I've only tested this on my computer, so it may be different on other systems.
• The above process utilizes the system Temp directory, obtained through the GetTempDirectory function graciously borrowed from Thushan Fernando. This should make the function more portable to other systems. However, for some reason, the Kodak Imaging Previewer (kodakprv.exe /p) doesn't seem to be able to load files from this directory on my system. I may have to recode the above function to allow for a different temp directory... unless I can find another image printer that will work properly.

Now that this is coming along, I should see if there's a decent way to print just the main email (no attachments) of an Outlook MailItem object without resorting to the PrintOut method. With that, I can rewrite my original Email Converter program to account for unprintable files.

If anyone finds this useful, relevent, or at the very least just a little bit interesting, drop me a line.