Outlook: Sending emails with attachments using reminder

[NewAtVba]

Hi, i recently bought "Office VBA Macros You Can Use Today". I am trying out the outlook macro that sends out emails with attachments when a reminder occurs.

This is the code.

Option Explicit
'****
Private Sub Application_Reminder(ByVal Item As Object)
Call SendFiles(Item)
End Sub

Private Sub SendFiles(objTask As TaskItem)
Dim objMail As Object
Dim msg As Object
Dim strCategoryName As String
Dim strFileName As String
Dim strContact
Dim i As Integer 'Counter
On Error GoTo ErrorHandler

strCategoryName = "Custom"
If Not objTask.Categories = strCategoryName Then Exit Sub

If Dir(objTask.Body) = "" Then Exit Sub
strFileName = Trim(objTask.Body)
Set objMail = Application.CreateItem(olMailItem)
With objMail
.Subject = objTask.Subject
.Attachments.Add strFileName
strContact = Split(objTask.ContactNames, ",")


If Not IsArray(strContact) Then
strContact = Split(objTask.ContactNames, ",")
End If

For i = 0 To UBound(strContact)
.Recipients.Add strContact(i)
Next i
.Send
End With

With objTask
.ReminderSet = False
.Close olSave
End With

ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Number & "-" & Err.Description, _
vbOKOnly + vbExclamation, "Error"
GoTo ExitSub
End Sub


The code compiles with no errors; i've put the filename in the body of the reminder; i've changed and placed the task in the correct category called 'Custom' but when the reminder fires, nothing is sent out at all, with no errors as well.

I believe it's not sending because of the contacts part(in red font) of the code. i've also tried placing contacts in a 'Custom' category as well but that did not work.

The example shown in the book shows outlook 2003. im wondering if that makes a difference?

 

[Derek Brown]

Could you say which version of Excel is being used, please, and also what is firing the reminder (meeting, task etc.).
Also it would be useful to know the page in the book that you used.
I use a similar technique at work, so may then be able to help you in the next couple of days.

 

[Derek Brown]

Sorry, the question should have been "which version of Outlook?".

 

[Maheshp]

Hi

check whether this helps
www.rondebruin.nl/mail/change.htm

 

[NewAtVba]

Could you say which version of Excel is being used, please, and also what is firing the reminder (meeting, task etc.).

Hi, i use Outlook 2007 and a task fires the reminder.

Also it would be useful to know the page in the book that you used.

It starts on page 287, under "Sending Daily Attachments to Certain Recipients"

Thanks for helping!

 

[Derek Brown]

I haven't had a chance to look at the page in the book yet - that is at home.
Here is some code that works for me using Excel 2007. Apologies if there are any errors - it was necessary for me to remove some of the code to just give you the relevant bits to 'wrap around' your specific code. Also, I may have left-in some 'obsolete' code.
The following needs to be added to the "ThisOutlookSession" class module:

Option Explicit
Private WithEvents colReminders As Outlook.Reminders
Private Sub Application_Startup()
    Set colReminders = Application.Reminders
End Sub
Private Sub colReminders_BeforeReminderShow(Cancel As Boolean)
' Note: this will suppress all reminders in this session
    Cancel = True 'cancel showing reminders window
End Sub

Private Sub colReminders_ReminderFire(ByVal ReminderObject _
    As Reminder)
' Processes ALL reminders
Dim objTask As Outlook.TaskItem
' ====================================================
Dim dblNow As Double
Dim dblTime As Double
Dim intHour As Integer
Dim intMinute As Integer
Dim dtNextReminder As Date
Dim strTaskSubject As String
Dim intReminderHours As Integer
Dim intDayNumber As Integer
Dim intTaskID As Integer
'
' Ignore any errors:
    On Error GoTo Exit_Para
    '
    strTaskSubject = ReminderObject.Caption
    intReminderHours = 1 'safety-net
    '
' ****************************************************
' ****************************************************
' ****************************************************
' ====================================================
    ' ALLOW ONLY "APPROVED" TASKS BEYOND THIS POINT:
    If ((strTaskSubject <> "My Task Subject 1") And _
        (strTaskSubject <> "My Task Subject 2")) Then
        GoTo Exit_Para
    End If
' ====================================================
' ****************************************************
' ****************************************************
' ****************************************************
' My Task Subject 1:
    If strTaskSubject = "My Task Subject 1" Then
        intReminderHours = 24 ' one day
        '
        ' Do something here
        '
    End If
' ====================================================
' My Task Subject 2:
    If strTaskSubject = "My Task Subject 2" Then
        intReminderHours = 168 'one week
        '
        ' Do something here
        '
    End If
' ====================================================
' RESET REMINDER:
    ' Prepare time for next instance of task:
    dtNextReminder = ReminderObject.NextReminderDate + TimeSerial(intReminderHours, 0, 0)
    ' Remove reminder:
    ReminderObject.Dismiss
    '
    ' Reset (new) task for next action:
    Set objTask = Outlook.CreateItem(olTaskItem)
    With objTask
        .StartDate = dtNextReminder
        .Subject = strTaskSubject
    '       .Status = olTaskInProgress
    '       .Importance = objItem.Importance
        .DueDate = dtNextReminder
        .ReminderSet = True
        .ReminderTime = dtNextReminder
        .Save
    End With
    '
    ' Now tidy old tasks:
    TidyTasks
    '
Exit_Para:
'
Set objTask = Nothing
'
End Sub

The following needs to be added in a code module:

Option Explicit
Sub TidyTasks()
Dim objTaskFolder As Outlook.MAPIFolder
Dim objTaskItems As Outlook.Items
Dim objNS As Outlook.NameSpace
Dim objTaskItem As Outlook.TaskItem
Dim lngKount As Long
'
Set objNS = Application.GetNamespace("MAPI")
Set objTaskFolder = objNS.GetDefaultFolder(olFolderTasks)
Set objTaskItems = objTaskFolder.Items
  For lngKount = objTaskItems.Count To 1 Step -1
    If IsTask(objTaskItems.Item(lngKount)) Then
        Set objTaskItem = objTaskItems.Item(lngKount)
        If ((objTaskItem.Subject = "My Task Subject 1") Or _
                (objTaskItem.Subject = "My Task Subject 2")) Then
            If objTaskItem.ReminderTime < (Now() - TimeValue("12:00:00")) Then
                ' more than 12 hours old, so delete
                objTaskItem.Delete
            End If
        End If
    End If
  Next lngKount
Set objTaskItems = Nothing
Set objTaskFolder = Nothing
Set objNS = Nothing
End Sub
Function IsTask(oItem As Object) As Boolean
  IsTask = (TypeName(oItem) = "TaskItem")
End Function

 

[NewAtVba]

Hi, I'm a little confused. Can i get some directions regarding where i can put in my code?

 

[Derek Brown]

Where you see the code:

' My Task Subject 1:
    If strTaskSubject = "My Task Subject 1" Then
        intReminderHours = 24 ' one day
        '
        ' Do something here
        '
    End If

you can replace "Do something here" with a call to your code to do what you want.
Although you could just add your code at that point, I suggest keeping your code in a separate code module to make it easier to follow and maintain.
You will also need to change the task subject ("My Task Subject 1" in the above example) to whatever you want it to be.

 

[NewAtVba]

i put this inside and changed my task subject(see pic). The reminder fired but nothing was sent. Am i doing anything wrong?

My Task Subject 1:
If strTaskSubject = "My Task Subject 1" Then
intReminderHours = 24 ' one day
Dim oMI As MailItem
Set oMI = Application.CreateItem(olMailItem)
With oMI
.To = "s8708908h@hotmail.com"
.Subject = "overdue"
.Attachments.Add "C:\Documents and Settings\xinghui.liu.2008\Desktop\test.xls"
.Send
End With
Set oMI = Nothing

End If

 

[Derek Brown]

Perhaps I should have asked whether you are using XP or Windows 7, although it should not make any difference to this answer. Looking at the page in the book, it probably is for Outlook 2003 - there were many changes with Office 2007, particularly Excel and Outlook.
1. I cannot see anything wrong with your code that creates the email - it is very similar to that used in my system (I have a server that runs a Data Warehouse and reporting system).
2. You need to make sure that macros are enabled, but see '4' below.
3. At this point I would run the code in debug mode to see exactly what is happening in the code when the task reminder fires. That way, you will see if it reaches your bit of email code.
4. There is more security with Office 2007 (and also Windows 7) and I found that it was necessary to have my Outlook code digitally signed. Without it, it would be necessary for someone to click 'OK' to a dialog box before the email is sent. Perhaps also check your Drafts folder in case you emails are there. I used "Self Certification" as described at:
http://www.howto-outlook.com/howto/selfcert.htm
It may look it, but it is not difficult.