question

RachelPederson-6222 avatar image
0 Votes"
RachelPederson-6222 asked RachelPederson-6222 answered

Automating Outlook Reminders from Excel Table

I have an excel table that contains information to set up a reminder in Outlook.
Columns include Location, Start Date/Time, Duration, Busy Status, Reminder Time, Body, and Created. I have a problem with the code. Every time I run it, it deletes the first row in my table.

Sub AddAppointments()
Dim LastRow As Long
Dim I As Long
Dim xRg As Range
Dim xOutApp As Object
Dim xOutItem As Object
Set xOutApp = CreateObject("Outlook.Application")
Set xRg = Range("A2:G2")
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For I = 1 To LastRow
Set xOutItem = xOutApp.CreateItem(1)
Debug.Print xRg.Cells(I, 1).Value
xOutItem.Subject = xRg.Cells(I, 1).Value
xOutItem.Location = xRg.Cells(I, 2).Value
xOutItem.Start = xRg.Cells(I, 3).Value
xOutItem.Duration = xRg.Cells(I, 4).Value
If Trim(xRg.Cells(I, 5).Value) = "" Then
xOutItem.BusyStatus = 2
Else
xOutItem.BusyStatus = xRg.Cells(I, 5).Value
End If
If xRg.Cells(I, 6).Value > 0 Then
xOutItem.ReminderSet = True
xOutItem.ReminderMinutesBeforeStart = xRg.Cells(I, 6).Value
Else
xOutItem.ReminderSet = False
End If
xOutItem.Body = xRg.Cells(I, 7).Value
xOutItem.Save
xRg = Range("A" & I + 1, "G" & I + 1)
Next
Set xOutApp = Nothing
End Sub

Where did I go wrong?

Also, I want to set a conditional statement so that it only runs the macro on new data so I don't duplicate appointments. Basically, if column H (Created) is yes, then to skip that line and only create an appointment if Column H = nothing.

Thanks!

office-excel-itprooffice-vba-dev
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

Viorel-1 avatar image
0 Votes"
Viorel-1 answered Viorel-1 commented

Try replacing 'xRg = ...' with 'Set xRg = ...'. But this line is not needed. It must be removed.

For the second problem, try adding an If; something like this:

 For I = 1 To LastRow
    If LCase(Trim(xRg.Cells(I, 8).Value)) <> "yes" Then
       . . .            
    End If
 Next


· 2
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

I tried that. But for some reason when I run the code, now it is deleting my content in A2 (not the whole line, so that's an improvement) but I get an error that says: Object or variable or With block variable not set. for Set xOutItem=xOutApp.CreateItem(1)

Here is how I fixed the code. Did I get the items in the right spot?
Sub AddAppointments()
Dim LastRow As Long
Dim I As Long
Dim xRg As Range
Dim xOutApp As Object
Dim xOutItem As Object
Set xOutApp = CreateObject("Outlook.Application")
Set xRg = Range("A2:G2")
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For I = 1 To LastRow
If LCase(Trim(xRg.Cells(I, 8).Value)) <> "yes" Then
Set xOutItem = xOutApp.CreateItem(1)
Debug.Print xRg.Cells(I, 1).Value
xOutItem.Subject = xRg.Cells(I, 1).Value
xOutItem.Location = xRg.Cells(I, 2).Value
xOutItem.Start = xRg.Cells(I, 3).Value
xOutItem.Duration = xRg.Cells(I, 4).Value
If Trim(xRg.Cells(I, 5).Value) = "" Then
xOutItem.BusyStatus = 2
Else
xOutItem.BusyStatus = xRg.Cells(I, 5).Value
End If
If xRg.Cells(I, 6).Value > 0 Then
xOutItem.ReminderSet = True
xOutItem.ReminderMinutesBeforeStart = xRg.Cells(I, 6).Value
Else
xOutItem.ReminderSet = False
End If
xOutItem.Body = xRg.Cells(I, 7).Value
xOutItem.Save
Set xRg = Range("A" & I + 1, "G" & I + 1)

     Set xOutApp = Nothing
 End If
 Next

End Sub

0 Votes 0 ·
Viorel-1 avatar image Viorel-1 RachelPederson-6222 ·

I think that the error appeared after reordering the 'Next' and 'Set xOutApp = Nothing' lines. The latter must be put after 'Next'.

The line 'Set xRg = Range("A" & I + 1, "G" & I + 1)' should be removed.


0 Votes 0 ·
RachelPederson-6222 avatar image
0 Votes"
RachelPederson-6222 answered

Thank you! It is working now.

5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.