Hello Everyone,
i am newbie in writing macros. eventually wrote a bit of it scraping the internet for ideas and help. now i am stuck here.
what i want is that on receipt of every email, if the subject of the email contains one of the words "rollover" or "repayment" or "drawdown" anywhere in the whole subjectline, only then the attachments should be downloaded and saved on the local drive. but its not working, even if the subject contains those words, it doesnt download and save any attachments at all.
This is what i have got so far.
[/code]
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Dim olRecipient As Outlook.Recipient
Dim olfolder As Folder
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set olRecipient = objectNS.CreateRecipient("Mum-Oper-Lnd")
olRecipient.Resolve
Set olfolder = objectNS.GetSharedDefaultFolder(olRecipient, olFolderInbox)
'Set olfolder = olfolder.Folders("Advices")
Set inboxItems = olfolder.Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim Filename As String
Dim attach As Attachment
Dim subject As String
If TypeName(Item) = "MailItem" Then
Set Msg = Item
subject = Msg.subject
If InStr(1, subject, "rollover") > 0 Then
For Each attach In Msg.Attachments
Dim filetype As String
filetype = LCase$(Right$(attach.Filename, 4))
Select Case filetype
Case ".pdf"
Filename = "P:\attachment\" & attach.Filename
attach.SaveAsFile Filename
End Select
Next
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox (Err.Number & " - " & Err.Description)
Resume ProgramExit
End Sub
[/code]
Thanks in advance for the help.
i am newbie in writing macros. eventually wrote a bit of it scraping the internet for ideas and help. now i am stuck here.
what i want is that on receipt of every email, if the subject of the email contains one of the words "rollover" or "repayment" or "drawdown" anywhere in the whole subjectline, only then the attachments should be downloaded and saved on the local drive. but its not working, even if the subject contains those words, it doesnt download and save any attachments at all.
This is what i have got so far.
[/code]
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Dim olRecipient As Outlook.Recipient
Dim olfolder As Folder
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set olRecipient = objectNS.CreateRecipient("Mum-Oper-Lnd")
olRecipient.Resolve
Set olfolder = objectNS.GetSharedDefaultFolder(olRecipient, olFolderInbox)
'Set olfolder = olfolder.Folders("Advices")
Set inboxItems = olfolder.Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim Filename As String
Dim attach As Attachment
Dim subject As String
If TypeName(Item) = "MailItem" Then
Set Msg = Item
subject = Msg.subject
If InStr(1, subject, "rollover") > 0 Then
For Each attach In Msg.Attachments
Dim filetype As String
filetype = LCase$(Right$(attach.Filename, 4))
Select Case filetype
Case ".pdf"
Filename = "P:\attachment\" & attach.Filename
attach.SaveAsFile Filename
End Select
Next
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox (Err.Number & " - " & Err.Description)
Resume ProgramExit
End Sub
[/code]
Thanks in advance for the help.