using VB to retrieve attachments from .msg files

[Alan87]

Hi,

Im fairly new to VB and wondered if anyone can. I have created a script and a rule in Outlook, that will automatically pull attachments into a specific folder on my desktop. I have managed to tweak the code so it only pulls PDF & TIF files, and will place a number in front of the file name if there are any duplicates. Code works fine. My problem is when I receive emails that have a .msg file attached, I need the VB code to automatically pull the PDF attachment from within the .msg file. I've looked through a number of forums and the process seems quite complex. Can you anyone offer any help?

I'm using Outlook 2007, this is the code I have at the moment:

'A Script to Auto Pull email attachements into a designated folder'


Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
'This states where the attached Invoice will be saved to'
saveFolder = "C:\Users\nicholson.a.9\Desktop\Invoices to Print"
For Each objAtt In itm.Attachments
'This notifys excel to only save the attachement if it is .pdf /.PDF or .tif'
'The upper and lower case "PDF" "pdf" matter!'
If (Right(objAtt.fileName, 3) = "pdf") Or (Right(objAtt.fileName, 3) = "PDF") Or (Right(objAtt.fileName, 3) = "tif") Or (Right(objAtt.fileName, 3) = ".MSG") Then
stFileName = saveFolder & "\" & objAtt.DisplayName
i = 0
JumpHere:
'The below states that if an attachemnt is a duplicate then the script will add'
'A number to the beggining of the file name i.e. 1 then 2 then 3 '
If Dir(stFileName) = "" Then
objAtt.SaveAsFile stFileName
Else
i = i + 1
stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
GoTo JumpHere
'The below closes the above IF statements'
End If
End If


Set objAtt = Nothing
Next
End Sub

Help!
Thanks