forward on emails based on criteria, as attachments.

[neemi]

I want to have a button on outlook which when I press it it will match up emails in the sent box where for example:

to = "Someone@ABC.com"
datesent = currentDate
subject = "This subject"

So I press the button and the emails that match the criteia are added to a new message as attachments and the email is displayed to me ready to send.

Help appreciated.
Cheers,
Neemi

 

[TomCologne]

The following procedure will find a message in the Ol 'Sent Items' folder matching certain specified criteria.

There are a lot of posts regarding creating messages
in the fora & FAQs, you could eg proceed with another procedure call for matching messages.

Note: Code originally for Acc2k, modified

[COLOR=green]
'''''''''''''''''''''''''''''''''''''''''''''''
'' Ol2k, Acc2k
'' Find message in Ol 'Sent Items' folder
'' matching spec criteria
''
''' Create OL button:
'''
''' 1. View>Toolbars>Customize...>Toolbars>New
''' 2. Enter a name for toolbar
''' 3. Click "Commands" tab
''' 4. Select "Macros" in "Categories"
''' 5. Drag "Project1.FindSentMail onto button
''' 6. Optional: Modify Selection
''
'''''''''''''''''''''''''''''''''''''''''''''''
[/color green]
Sub FindSentMail()
On Error GoTo Err_FindSentMail

Dim molApp As Outlook.Application, _
     molNamespace As Outlook.NameSpace, _
      molMAPI As Outlook.MAPIFolder, _
       molItem As Outlook.MailItem

    Set molApp = CreateObject("Outlook.Application")
    Set molNamespace = Application.GetNamespace("MAPI")
    Set molMAPI = molNamespace.GetDefaultFolder(5) '(olFolderSentMail)
        
       For Each molItem In molMAPI.Items
         [COLOR=green]'' Criteria:[/color green]
         If InStr(molItem.To, "YourRecipientHere") > 0 _
              And molItem.SentOn = Date _
                And InStr(molItem.Subject, "YourSubjectHere") > 0 Then
[COLOR=green]
                '' Test in Immediate window:[/color green]                
                Debug.Print molItem.To, molItem.SentOn, molItem.Subject
[b][COLOR=green]
                '' If 'FindSentMail' works properly you could
                '' insert your next procedure call here.
[/color green][/b]
          End If
            
        Next molItem

Exit_FindSentMail:
       
    Set molMAPI = Nothing
    Set molNamespace = Nothing
    Set molApp = Nothing   
        
    Exit Sub

Err_FindSentMail:

    Debug.Print Err.Number, Err.Description
    Resume Next
    
End Sub

This will hopefully get you started,


TomCologne