Hi,
I have to forward e-mails every day, which always contain two attachments.
I always have to delete one of the attachments and only then can I forward it.
I'm looking for a macro that can do this automatically.
Of two attachments (pdf), one always starts with 'invoice_' followed by a random number. The second PDF always starts with 'detailinfo_' and a random number.
I am not a vba expert. My current code is based on the internet and my own modifications.
The code works except for one point, it removes detailinfo_*.pdf from the original message and not from the email to be sent. The original message should just stay as it is.
my code:
Sub DelAttAndForward()
'
Dim xFileSystemObj, xShellApp As Object
Dim xNameSpace, xNameSpaceItem, xItem As Object
Dim xTempFldPath, xFilePath As String
Dim xSelItems As Outlook.Selection
Dim xFWItems As Outlook.Selection
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim Atmt As Outlook.Attachment
Dim objFSO As Object
Dim sExt As String
Dim myinspector As Outlook.Inspector
Set xFileSystemObj = CreateObject("Scripting.FileSystemObject")
Set objForward = ActiveExplorer.Selection.Item(1).Forward
objForward.Display
Set xFWItems = Outlook.ActiveExplorer.Selection
Set xShellApp = CreateObject("Shell.Application")
Set xNameSpace = xShellApp.NameSpace(0)
Set myinspector = Application.ActiveInspector
Set myItem = myinspector.CurrentItem.Forward
For Each xItem In xFWItems
If xItem.Class = OlObjectClass.olMail Then
Set xMailItem = xItem
Set xAttachments = xMailItem.Attachments
Set objFSO = CreateObject("Scripting.FileSystemObject")
End If
For Each xAttachment In xAttachments
xFilePath = xAttachment.FileName
If xFilePath Like "invoice_*.pdf" Then
xFilePath2 = xAttachment.FileName
objForward.Subject = ("[VRK] ") & xFilePath2
End If
If xFilePath Like "detailinfo_*.pdf" Then
Set objForward = Item.Forward
xAttachment.Delete
End If
Next
Next
Set Atmt = Nothing
Set xItem = Nothing
Set xNameSpaceItem = Nothing
Set xNameSpace = Nothing
Set xShellApp = Nothing
Set xFileSystemObj = Nothing
End Sub