Solved: Macro to send email

[morrtz]

Hi,

I'm looking for a macro that can check email items in a folder by a user defined Date field, checking if it is outdated for 7 days, If the user defined date field is 7 days old than an email item needs to be sent with a predefined text with several dynamic fields in the text from other user defined fields of that same item.

Thanks for any assistence.

[Paleo]

What about this?

[vba]
Sub mMail()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objItems As Items
Dim objItem As Object
Dim newTel As String
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If Not objFolder Is Nothing Then
Set objItems = objFolder.Items
For Each objItem In objItems
If objItem.usrDate = date(today()-7) then
Call SendEmail()
End if
Next
End If
Set objItems = Nothing
Set objItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub

Sub SendEmail()
'Here you can use the code in http://support.microsoft.com/kb/161088
End Sub
[/vba]

Tell a little bit more about what you want

[morrtz]

Hi Paleo,

Thanks alot for the code!
I'm having a Syntax error with the most important line -
If objItem.usrDate = date(today()-7) Then

I'm guessing something with the date(today..

[morrtz]

Sorry to double post, I just saw what you wrote under the code -

This Macro will be a Support Center procedure that will run on a OL Addin folder that is managing the all the support issues.
Any items that are in that folder which have a date on a custom field older than 7 days should send an automated message template to a custom field of that same item which has an email in it.

[morrtz]

The Macro is complete, Thanks for the help!

[VBA]Sub mMail()
Dim i As Long 'Cycle Counter
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As Object
Dim objItems As Items
Dim objItem As Outlook.MailItem
Dim UDF As String 'Defining the Field name
Dim objProperty As Outlook.UserProperty 'Defining the UDF Item


Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder.Items
If Not objFolder Is Nothing Then ' Check if selection is not empty
For i = 1 To objFolder.Count ' Go through each item with each cycle
Set objItem = objFolder.Item(i) ' Set the current cycle's email
If objItem.UserProperties.Item(6).Value = "XXXX" And objItem.LastModificationTime >= DateToday - 7 Then
Call SendMessage(True, "C:\Customers.txt")
End If
Set objItem = Nothing
Next i
End If




Set objItems = Nothing
Set objItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing

End Sub

Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Nancy Davolio")
objOutlookRecip.Type = olTo

' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Michael Suyama")
objOutlookRecip.Type = olCC

' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
objOutlookRecip.Type = olBCC

' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "This is the body of the message." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance

' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If

' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next

' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub

[/VBA]