Save or Print attachmets from nested attached msg files

[dylan666]

Hi guys,
I have some emails that have some MSG emails attacched.
Inside these emails there are some PDF files and I need to print or save them.

What is the code for select some emails (using mouse) and then print or save the PDF inside the MSG attached?

Thanks in advance

[westconn1]

to print the pdf files from selected emails


For Each itm In ActiveExplorer.Selection
For Each a In itm.Attachments
If InStr(a.FileName, ".pdf") > 0 Then
' print file here
End If
Next
Nexti would suggest using shellexecute API with print verb, to print the pdf files, this will open the default program used for opening pdf file
code depends if you want to print using a specific program or default

[dylan666]

Coul you show me an example about shellexecute for printing?

Thanks in advance

[westconn1]

in the general section (at top of module)

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)
Private Const SW_SHOWNORMAL = 1


i believe you would have to save the attachment as a temporary file, then delete after printing if required

also as your pdfs are within attached messages, it may be necessary to loop through each attachments attachments like

sPathFile = "c:\temp\temp.pdf" ' change to suit
For Each itm In ActiveExplorer.Selection
For Each msg In itm.Attachments
For Each a In msg.Attachments
If InStr(a.FileName, ".pdf") > 0 Then
' print file here
a.SaveAsFile sPathFile ' overwritten each time
lngRet = ShellExecute(0, "print", sPathFile, vbNullString, vbNullString, SW_SHOWNORMAL)
End If
Next
Next
Next
as i have no messages with message attachments, with pdfs attached, i was unable to test
the program that prints the pdf should close, but depending which program is the default, this may not be the case

[dylan666]

Can I print without saving a temporary file?

[westconn1]

i doubt it,
i would believe that is how outlook would do it internally
same as opening some file from within a zip, file is saved in background to temp folder, then opened

[dylan666]

I get an error on this line:

For Each a In msg.Attachments

The message is: Object doesn't support this property or method.
Can you help me?

[dylan666]

Are you sure that is possible to open an MSG attached in outlook?
Because I found a link where they say to save the MSG and then open it with Namespace.OpenSharedItem

Can you give me an example?

Thanks in advance

[skatonni]

Re: Object doesn't support this property or method.

The code should look like this.


For Each itm In ActiveExplorer.Selection
For Each a In itm.Attachments
If InStr(a.FileName, ".pdf") > 0 Then
' print file here
a.SaveAsFile sPathFile ' overwritten each time
lngRet = ShellExecute(0, "print", sPathFile, vbNullString, vbNullString, SW_SHOWNORMAL)
End If
Next
Next

[dylan666]

Your code is perfect if a PDF is attached, but I have some MSG attached and a PDF inside each of them
This is the problem....

[westconn1]

on testing, you can not open an attachment from an attached message directly

try like

Sub msgs()
Dim msg As MailItem, a As MailItem, m As Attachment, t As MailItem, tmp As String
tmp = "c:\temp\qwerty.msg"
Set msg = ActiveExplorer.Selection(1)

For Each m In msg.Attachments
If LCase(Right(m.FileName, 4)) = ".msg" Then
m.SaveAsFile tmp
Set t = CreateItemFromTemplate(tmp)
For Each a In t.Attachments
printpdfs a
Next
Else
printpdfs m ' handle normal attachments
End If
Next
Set a = CreateItemFromTemplate(tmp)
End Sub


Sub printpdfs(attch As Attachment)
Dim tmpfile As String
tmpfile = "c:\temp\tmp.pdf"
attch.SaveAsFile tmp
lngRet = ShellExecute(0, "print", tmpfile, vbNullString, vbNullString, SW_SHOWNORMAL)
End Sub
this is not tested, in whole, so may contain some code error or typos
the concept of saving the msg attachment, then opening as a mailitem with attachments is tested as correct
you should do more testing that any attachment is of the correct type for the action you are going to take with it

[dylan666]

Error at this line:
For Each a In t.Attachments

The error message is:
Run-time error '13': Type Mismatch

However qwerty.msg file has been correctly saved in C:\temp folder

[westconn1]

a should be attachment, change the dim

[dylan666]

Ok, there was another error here:

OLD VERSION:
tmpfile = "c:\temp\tmp.pdf"
attch.SaveAsFile tmp

NEW VERSION:
tmpfile = "c:\temp\tmp.pdf"
attch.SaveAsFile tmpfile

Now I get the error "Run-time error '13': Type Mismatch" at this line:
Set a = CreateItemFromTemplate(tmp)

Thanks for your help!!

[westconn1]

that line should have been removed, it was just when i was testing, to avoid confusion i will re-post entire code, with fixes

Sub msgs()
Dim msg As MailItem, a As Attachment, m As Attachment, t As MailItem, tmp As String
tmp = "c:\temp\qwerty.msg"
Set msg = ActiveExplorer.Selection(1)

For Each m In msg.Attachments
If LCase(Right(m.FileName, 4)) = ".msg" Then
m.SaveAsFile tmp
Set t = CreateItemFromTemplate(tmp)
For Each a In t.Attachments
printpdfs a
Next
kill tmp
Else
printpdfs m
End If
Next
End Sub
Sub printpdfs(attch As Attachment)
Dim tmpfile As String
tmpfile = "c:\temp\tmp.pdf"
attch.SaveAsFile tmpfile
lngRet = ShellExecute(0, "print", tmpfile, vbNullString, vbNullString, SW_SHOWNORMAL)
kill tmpfile
End Sub
as i had no pdfs in my attachments, i did not run the actual printing, though possibly at least some would print anyway, shellexecute would just use the appropriate application (if a registered file type) to print
there could be some timing issues with writing files and immediately reading back, but as this is not compiled, probably not an issue, it may pay to delete the tmp files, so i just add that now, if that causes any other issues, remove the kill lines

[dylan666]

I have removed the second kill line but printing it's not working.
Culd you check my code please?


Private Declare PtrSafe 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)
Private Const SW_SHOWNORMAL = 1

Sub Test1()
Dim msg As MailItem, a As Attachment, m As Attachment, t As MailItem, tmp As String
tmp = "c:\temp\qwerty.msg"
Set msg = ActiveExplorer.Selection(1)

For Each m In msg.Attachments
If LCase(Right(m.FileName, 4)) = ".msg" Then
m.SaveAsFile tmp
Set t = CreateItemFromTemplate(tmp)
For Each a In t.Attachments
If LCase(Right(a.FileName, 4)) = ".pdf" Then
printpdfs a
End If
Next
Kill tmp
Else
'printpdfs m
End If
Next
End Sub
Sub printpdfs(attch As Attachment)
Dim tmpfile As String
tmpfile = "c:\temp\" & attch.FileName
attch.SaveAsFile tmpfile
lngRet = ShellExecute(0, "print", tmpfile, vbNullString, vbNullString, SW_SHOWNORMAL)
'Kill tmpfile
End Sub



Is it correcto to use PtrSafe in the first line?
I have a 64 bit machine

[westconn1]

i deliberately used a fixed filename for tmpfile, so it would be overwritten each time
if you want to keep the pdf files your way is best

are the tmpfile(s) created in the temp folder?
if not created, the problem must be in reading the msg attachment

test to see if it will print some if you step through 1 line at a time, it may be that either createitemfromtemplate or shellexecute try to read the file before it is finished writing, as file i/o may not be complete even though the code continues (as mentioned in post #15)
if that could be the case, you can try


Do While FileLen(tmp) = 0
DoEvents
l = l + 1
If l > 10000 Then MsgBox tmp & " timed out": Exit Sub
Loopyou can do both for tmp and tmpfile,
note i copied this directly from another program that had this issue, i put the timeout to prevent for-ever loop

[dylan666]

I'm trying to test only the printing part using a file called 1.pdf and it desn't work.
This is the code:




Private Declare PtrSafe 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)
Private Const SW_SHOWNORMAL = 1


Sub PrintPdf()
Dim printtmpfile As String
printtmpfile = "c:\temp\1.pdf"
lngRet = ShellExecute(0, "print", printtmpfile, vbNullString, vbNullString, SW_SHOWNORMAL)
End Sub



Any idea?
I'm using Outlook 2010
Thanks for all your support

[westconn1]

I'm using Outlook 2010but are you using a 64bit version of windows?

your test code works for me using the 32bit version of shellexecute as in post #4

note it may not work if you print to a pdf printer driver, seems like printing a pdf file to pdf file is not required or something

[dylan666]

Yes, I have a 64bit OS (Windows 8.1) and I am printing to a real printer

[westconn1]

i would have to find some 64 bit machine to test that, maybe later, i think there is only one here