- Joined
- Sep 4, 2008
- Messages
- 2
- Reaction score
- 0
Hi,
I found this VBA Script in a VBA Book I bought but it doesn't seem to work. It doesn't say what version of outlook it's for. It's supposed to automatically send an email with an attachment at certain times of the day using tasks to set it to run at the times I would like. I need to mail the attachment at 10:30am 2:30pm 7:30pm and 9:30pm to one person. The Script supposedly looks at the category and doesn't run unless it's a certain one. It runs fine one day but for the next day it doesn't click the reminder option to on so I have to manually click it every day. And sometimes it just bombs out giving me a "Run-Time error 13' Type mismatch error and highlighting Call SendFiles(Item)
I'm just starting out with VBA and have no idea why it's not working. Any help would be great.
Below is the whole script. It starts with Option Explicit. I had to modify it and delete the End If line at the end of the following part because it was giving a End If without Block If error.
Without the End If at the end of this part I can get it to work but it's real sketchy.
If Not IsArray(strContact) Then _
strContact = Split(objTask.ContactNames, ";")
End If
Option Explicit
' * * * * *
Private Sub Application_Reminder(ByVal Item As Object)
'Occurs immediately before the reminder is displayed
'And calls the macro that will do the job
Call SendFiles(Item)
End Sub
' * * * * *
Private Sub SendFiles(objTask As TaskItem)
'Outlook objects declaration
Dim objMail As Outlook.MailItem
Dim strCategoryName As String
Dim strFileName As String
Dim strContact
Dim i As Integer 'Counter
On Error GoTo ErrHandler
'Custom category that was created to use for this
'action
strCategoryName = "Daily Report Sender"
'If category name doesn't match then quit process
'And let reminder run normally
If Not objTask.Categories = strCategoryName Then Exit Sub
'Verify if specified file exists
'Quit process if it does not exist
If Dir(objTask.Body) = "" Then Exit Sub
'File name that is specified in task body section
strFileName = Trim(objTask.Body)
'Create mail object
Set objMail = Outlook.CreateItem(olMailItem)
With objMail
'Use same subject with Task Item
.Subject = objTask.Subject
'Attach related file
.Attachments.Add strFileName
'Add recipients
'Contact Names stores contact names with commas between
'DepartmentA, DepartmentB, DepartmentC
'So the names are split by using comma as delimiter
strContact = Split(objTask.ContactNames, ",")
'Checking if language settings require using
' ";" as list separator
If Not IsArray(strContact) Then _
strContact = Split(objTask.ContactNames, ";")
End If
'Adding recipients to new email message
For i = 0 To UBound(strContact)
.Recipients.Add strContact(i)
Next i
'Send message immediately
.Send
End With
With objTask
'Close reminder popup
.ReminderSet = False
.Close olSave
End With
ExitSub:
Exit Sub
ErrHandler:
'Critical error
MsgBox Err.Number & "-" & Err.Description, _
vbOKOnly + vbExclamation, "Error"
GoTo ExitSub
End Sub
Thanks in advance.
I found this VBA Script in a VBA Book I bought but it doesn't seem to work. It doesn't say what version of outlook it's for. It's supposed to automatically send an email with an attachment at certain times of the day using tasks to set it to run at the times I would like. I need to mail the attachment at 10:30am 2:30pm 7:30pm and 9:30pm to one person. The Script supposedly looks at the category and doesn't run unless it's a certain one. It runs fine one day but for the next day it doesn't click the reminder option to on so I have to manually click it every day. And sometimes it just bombs out giving me a "Run-Time error 13' Type mismatch error and highlighting Call SendFiles(Item)
I'm just starting out with VBA and have no idea why it's not working. Any help would be great.
Below is the whole script. It starts with Option Explicit. I had to modify it and delete the End If line at the end of the following part because it was giving a End If without Block If error.
Without the End If at the end of this part I can get it to work but it's real sketchy.
If Not IsArray(strContact) Then _
strContact = Split(objTask.ContactNames, ";")
End If
Option Explicit
' * * * * *
Private Sub Application_Reminder(ByVal Item As Object)
'Occurs immediately before the reminder is displayed
'And calls the macro that will do the job
Call SendFiles(Item)
End Sub
' * * * * *
Private Sub SendFiles(objTask As TaskItem)
'Outlook objects declaration
Dim objMail As Outlook.MailItem
Dim strCategoryName As String
Dim strFileName As String
Dim strContact
Dim i As Integer 'Counter
On Error GoTo ErrHandler
'Custom category that was created to use for this
'action
strCategoryName = "Daily Report Sender"
'If category name doesn't match then quit process
'And let reminder run normally
If Not objTask.Categories = strCategoryName Then Exit Sub
'Verify if specified file exists
'Quit process if it does not exist
If Dir(objTask.Body) = "" Then Exit Sub
'File name that is specified in task body section
strFileName = Trim(objTask.Body)
'Create mail object
Set objMail = Outlook.CreateItem(olMailItem)
With objMail
'Use same subject with Task Item
.Subject = objTask.Subject
'Attach related file
.Attachments.Add strFileName
'Add recipients
'Contact Names stores contact names with commas between
'DepartmentA, DepartmentB, DepartmentC
'So the names are split by using comma as delimiter
strContact = Split(objTask.ContactNames, ",")
'Checking if language settings require using
' ";" as list separator
If Not IsArray(strContact) Then _
strContact = Split(objTask.ContactNames, ";")
End If
'Adding recipients to new email message
For i = 0 To UBound(strContact)
.Recipients.Add strContact(i)
Next i
'Send message immediately
.Send
End With
With objTask
'Close reminder popup
.ReminderSet = False
.Close olSave
End With
ExitSub:
Exit Sub
ErrHandler:
'Critical error
MsgBox Err.Number & "-" & Err.Description, _
vbOKOnly + vbExclamation, "Error"
GoTo ExitSub
End Sub
Thanks in advance.
