Outlook 2007 - Extracting attachments from .msg

[alan87n]

Hi, I receive alot of emails which include .msg attachments. I usually have to manually open the email, then open the .msg attachment to get to the .pdf file which is attached. I often receive over 200 emails in this format and it takes some time to get all the PDF files printed. I managed to put together the below code (With a lot of help from the online forums). But i'm struggling on a few things and wondered if anyone can help:

1) I need to amend the code so it takes into consideration the .pdf files which have the same name, i.e. AT00001. Ideally if the code could add a number to the beggining of each file AT00001, 1-AT00001, 2-AT00001 etc
2) The code is currently pulling all attachments from within the .msg file, I only need the PDF files

Sub SaveOlAttachments()

Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Dim msg2 As Outlook.MailItem
Dim att As Outlook.Attachment
Dim strFilePath As String
Dim strTmpMsg As String
Dim fsSaveFolder As String

fsSaveFolder = "C:\Users\nicholson.a.9\Desktop\Invoices to Print\"


strFilePath = "C:\temp\"
strTmpMsg = "KillMe.msg"

Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("MSG Attachments")
If olFolder Is Nothing Then Exit Sub

For Each msg In olFolder.Items
If msg.Attachments.Count > 0 Then
While msg.Attachments.Count > 0
bflag = False
If Right$(msg.Attachments(1).FileName, 3) = "msg" Then
bflag = True
msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg
Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)
End If
If bflag Then
sSavePathFS = fsSaveFolder & msg2.Attachments(1).FileName
msg2.Attachments(1).SaveAsFile sSavePathFS
msg2.Delete
Else
sSavePathFS = fsSaveFolder & msg.Attachments(1).FileName
msg.Attachments(1).SaveAsFile sSavePathFS
End If
msg.Attachments(1).Delete
Wend
msg.Delete
End If
Next
End Sub

I would be hugely grateful if anyone can help
Thanks

[skatonni]

1 - See here for ways to save as a different name.
http://vbaexpress.com/forum/showthread.php?t=32499

2 - Similar to the test for "msg"
If Right$(msg2.Attachments(1).FileName, 3) = "pdf" Then

If you feel ambitious, you can practise using something more flexible that allows extensions longer than 3 characters. From post #4 in the link above
posr = InStrRev(objAtt.FileName, ".")
ext = Right(objAtt.FileName, Len(objAtt.FileName) - posr)

If ext = "pdf" Then

[davidlachnic]

How can I adjust this to prompt me for the destination... but not for me to type in... rather, that I can browse for the destination folder? Thanks.