Cris
10-24-2018, 02:23 AM
Hi all,
I'm new to the forum and this is my first post.
I have been given a piece of code for saving an attachment to a local folder if the email is moved into a specific folder in outlook. I've seen similar code on this forum so that may be where they got it from in the first place; if so, all credit goes to them.
Option Explicit
Dim WithEvents TargetFolderItems As Items
Const FILE_PATH As String = "\\tcc-fileserver\data extracts$\Engage Hub\"
Private Sub Application_Startup()
Dim ns As Outlook.NameSpace
Set ns = Application.GetNamespace("MAPI")
Set TargetFolderItems = ns.GetDefaultFolder(olFolderInbox).Folders("Extracts").Items
End Sub
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
Dim olAtt As Attachment
Dim i As Integer
If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
olAtt.SaveAsFile FILE_PATH & olAtt.FileName
Next
End If
Set olAtt = Nothing
End Sub
Private Sub Application_Quit()
Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing
End Sub
What I would ideally like to do is:
Move all emails which contain EngageHub to a specific folder in Outlook (Inbox/Extracts). I can do this with rules if it is not worth doing in VBA
Prefix the attachment name with the beginning of the Email Subject (the Email subject will contain the group name which will usually be formatted as GroupName1_EngageHub_ddMMyyyy. The attachment is usually just called EngageHub_ddMMyyyy.
Download the attachment to a local folder ("\\tcc-fileserver\data extracts$\Engage Hub"). The above code can do this for me.
My main issue is referencing the Outlook message subject. Any help would be greatly appreciated.
I'm new to the forum and this is my first post.
I have been given a piece of code for saving an attachment to a local folder if the email is moved into a specific folder in outlook. I've seen similar code on this forum so that may be where they got it from in the first place; if so, all credit goes to them.
Option Explicit
Dim WithEvents TargetFolderItems As Items
Const FILE_PATH As String = "\\tcc-fileserver\data extracts$\Engage Hub\"
Private Sub Application_Startup()
Dim ns As Outlook.NameSpace
Set ns = Application.GetNamespace("MAPI")
Set TargetFolderItems = ns.GetDefaultFolder(olFolderInbox).Folders("Extracts").Items
End Sub
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
Dim olAtt As Attachment
Dim i As Integer
If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
olAtt.SaveAsFile FILE_PATH & olAtt.FileName
Next
End If
Set olAtt = Nothing
End Sub
Private Sub Application_Quit()
Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing
End Sub
What I would ideally like to do is:
Move all emails which contain EngageHub to a specific folder in Outlook (Inbox/Extracts). I can do this with rules if it is not worth doing in VBA
Prefix the attachment name with the beginning of the Email Subject (the Email subject will contain the group name which will usually be formatted as GroupName1_EngageHub_ddMMyyyy. The attachment is usually just called EngageHub_ddMMyyyy.
Download the attachment to a local folder ("\\tcc-fileserver\data extracts$\Engage Hub"). The above code can do this for me.
My main issue is referencing the Outlook message subject. Any help would be greatly appreciated.