Email Reminders

[howard]

I have a workbook and have et up a macro to send a reminder to outlook, but get a run time error "type mismatch


The code below is highlighted

 .Start = DateValue(Range("D" & ctr)) + TimeValue(Range("D" & ctr))

See sample data and code below


It would be appreciated if someone could kindly amend my code

Book1
	A	B	C	D	E	F	G	H	I
2	No.	Branch	Chassis	Reminder Due Date-10	Due Date	Due Date Time	Duration	Subject	Time
3	1	Br1	AFD95075	18/02/2018 08:00	28/02/2018 00:00	28/02/2018 08:00	30	AFD95075 is due on 28/02/2018	08:00
4	2						30		08:00
5	3						30		08:00
6	4						30		08:00
Settlement Reminders

Cell Formulas
Range	Formula
B3	=IF(Settle!L2="","",Settle!L2)

 Sub Reminders()
     Dim startRow As Long, endRow As Long, ctr As Long
   
     startRow = 3
     endRow = Cells(Rows.Count, 1).End(xlUp).Row
     
     For ctr = startRow To endRow
        With CreateObject("Outlook.application").CreateItem(1)
            .Start = DateValue(Range("D" & ctr)) + TimeValue(Range("D" & ctr))
            .Duration = CLng(Range("G" & ctr)) ' 30
            .Subject = CStr(Range("H" & ctr)) ' subject text
            .ReminderSet = True
            .Save
        End With
     Next
End Sub

 

[pike]

Hi howard,
I picked up and use this,,,

Option Explicit
Sub Reminders()
     Dim startRow As Long, endRow As Long, ctr As Long
   
    Dim olApp As Outlook.Application
    Dim olAppt As Outlook.AppointmentItem
    Dim blnCreated As Boolean
    Dim olNS As Outlook.Namespace
    Dim CalFolder As Outlook.MAPIFolder
    Dim intCount As Long
    On Error Resume Next
    Set olApp = Outlook.Application
    If olApp Is Nothing Then
        Set olApp = Outlook.Application
         blnCreated = True
        Err.Clear
    Else
        blnCreated = False
    End If
      On Error GoTo 0
    Set olNS = olApp.GetNamespace("MAPI")
    Set CalFolder = olNS.GetDefaultFolder(olFolderCalendar)
    startRow = 3
   For ctr = startRow To endRow
  Set olAppt = CalFolder.Items.Add(olAppointmentItem)
    With olAppt
        .Start = DateValue(Range("D" & ctr)) + TimeValue(Range("D" & ctr))
       ' .End = ?????
        .Duration = CLng(Range("G" & ctr)) ' 30
        .Subject = CStr(Range("H" & ctr)) ' subject text
       ' .Location = ????
       ' .Body = ????
        .BusyStatus = olBusy
       ' .ReminderMinutesBeforeStart = ????
        .ReminderSet = True
       ' .Categories = ?????
        .Save
     End With
Next
   
    Set olNS = Nothing
    Set CalFolder = Nothing
    Set olAppt = Nothing
    Set olApp = Nothing
End Sub

 

[howard]

Thanks for the help. Code works perfectly