CODEWITHSUNDEEP
vbaoutlook
zxcvb
zxcvb

Reputation: 1

VBA - Moving Email Based on Attachment Filename

I'm trying to write a macro to move email if the attachment filename matches a string (for example, "asdfqwerty"). The email would move from my Inbox to the folder "Test" under my Inbox.

Using Redemption is not an option unfortunately.

Any help is appreciated!

Edit Here is my updated code based on the tips from Dmitry. I am now getting a 'Type mismatch' error on the very last Next and am not sure why:

Sub SaveOlAttachments()
Dim olFolder As MAPIFolder
Dim olFolder2 As MAPIFolder
Dim msg As mailItem

Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olFolder2 = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Test")

For Each msg In olFolder.Items
    If msg.Class = 43 Then
        If msg.Attachments.Count > 0 Then
            If Left$(msg.Attachments(1).FileName, 10) = "asdfqwerty" Then
            msg.Move (oldFolder2)
            End If
        End If
    End If
Next
End Sub

Upvotes: 0

Views: 509

Answers (2)

ASH
ASH

Reputation: 20342

The email with the attachment comes in and a Rule executes the following VBA script: 

Sub Test() 

'Declaration 
Dim myItems, myItem, myAttachments, myAttachment As Object 
Dim myOrt As String 
Dim myFin As String 
Dim myOlApp As New Outlook.Application 
Dim myOlExp As Outlook.Explorer 
Dim myOlSel As Outlook.Selection 

'Ask for destination folder 
myOrt = "W:\" 

On Error Resume Next 

'work on selected items 
Set myOlExp = myOlApp.ActiveExplorer 
Set myOlSel = myOlExp.Selection 

'for all items do... 
For Each myItem In myOlSel 

'point on attachments 
Set myAttachments = myItem.Attachments 

'if there are some... 
If myAttachments.Count > 0 Then 


'for all attachments do... 
For i = 1 To myAttachments.Count 

'Ask for destination folder 
myFin = InputBox("Please type a filename below:", "Saving 
recording...", "") 

'save them to destination 
myAttachments(i).SaveAsFile myOrt & _ 
myFin 

Next i 
End If 
Next 
End Sub

Upvotes: -1

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66286

Did you try to run that code? It will error on the msg.Attachments > 0 line. You need msg.Attachments.Count > 0.

The next line also won't run - you need to loop through all attachments in the msg.Attachments collection:

for each attach in msg.Attachments
  if InStr(attach.FileName, "asdfqwerty") Then
     msg.Move (olFolder2)
     Exit for
  End If
next

Before posting, please at least try to apply some effort to make sure your code compiles and maybe even runs. Do not expect other people to do that for you.

Upvotes: 0

Related Questions