[Solved] VBA to run macro with the most recent events

[rafaelbatalha]

Hello and good day to all!

I have a problem that i can't solve.
I have a excel sheet that run's a macro every time a close it.
The macro (that i found online) creates an event in Outlook calendars of diferent recipients.
The problem is that every time i open the sheet and add a new event, the macro repeats the alreday created events when i just want it to add the newest event.
I am not a programer and don't know how to code so please be patiente

I have this VBA code and it works for me but i don't know how to add the conditional format to make the macro run only on the most recent events.
can anyone please help??? here is the code

VBA Code:
Option Explicit


Sub AddAppointments()


Dim myoutlook As Object ' Outlook.Application
Dim r As Long
Dim myapt As Object ' Outlook.AppointmentItem


' late bound constants
Const olAppointmentItem = 1
Const olBusy = 2
Const olMeeting = 1


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


' Start at row 2
r = 2


Do Until Trim$(Cells(r, 1).Value) = ""
' Create the AppointmentItem
Set myapt = myoutlook.CreateItem(olAppointmentItem)
' Set the appointment properties
With myapt
.Subject = Cells(r, 1).Value
.Location = Cells(r, 2).Value
.Start = Cells(r, 3).Value
.End = Cells(r, 4).Value
.Recipients.Add Cells(r, 8).Value 'this line will be repeated for each column that has email adresses
.MeetingStatus = olMeeting
' myapt.Recipients.ResolveAll
.AllDayEvent = Cells(r, 9).Value


' If Busy Status is not specified, default to 2 (Busy)
If Len(Trim$(Cells(r, 5).Value)) = 0 Then
.BusyStatus = olBusy
Else
.BusyStatus = Cells(r, 5).Value
End If


If Cells(r, 6).Value > 0 Then
.ReminderSet = True
.ReminderMinutesBeforeStart = Cells(r, 6).Value
Else
.ReminderSet = False
' now is the point where i would like that the code only reads new entries to the worksheet and not repeat reminders for already created items
' i think it has something to do with conditional formating
End If

 

[Yousuf Shovon]

I have this VBA code and it works for me but i don't know how to add the conditional format to make the macro run only on the most recent events.
can anyone please help???

Hello Rafael,
Welcome to ExcelDemy forum. Thanks for sharing your experience with us.

I understand you want to run the given VBA code with the most recent issues but are facing issues. As suggested, conditional formatting cannot directly solve the issue of identifying new entries in your Excel sheet. However, I did fix up the code a bit.

The Macro auto-marks entries "Done" & skips them on future runs.

Use this code instead:

Option Explicit

Sub AddAppointments()
    'Developed by ExcelDemy
    Dim myoutlook As Object ' Outlook.Application
    Dim r As Long
    Dim myapt As Object ' Outlook.AppointmentItem
    Dim ws As Worksheet
    Dim lastRow As Long

    ' Late-bound constants
    Const olAppointmentItem = 1
    Const olBusy = 2
    Const olMeeting = 1
    
    Set ws = ThisWorkbook.ActiveSheet

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set myoutlook = CreateObject("Outlook.Application")

    ' Start at row 2
    r = 2

    Do Until r > lastRow
        ' Check if the entry in column J is not "Done"
        If ws.Cells(r, 10).Value <> "Done" Then
            ' Create the AppointmentItem
            Set myapt = myoutlook.CreateItem(olAppointmentItem)
            ' Set the appointment properties
            With myapt
                .Subject = ws.Cells(r, 1).Value
                .Location = ws.Cells(r, 2).Value
                .Start = ws.Cells(r, 3).Value
                .Duration = ws.Cells(r, 4).Value
                .Recipients.Add ws.Cells(r, 8).Value
                .MeetingStatus = olMeeting
                ' Not necessary if recipients are email addresses
                ' .Recipients.ResolveAll
                .AllDayEvent = ws.Cells(r, 9).Value

                ' If busy status is not specified, default to 2 (Busy)
                If Len(Trim$(ws.Cells(r, 5).Value)) = 0 Then
                    .BusyStatus = olBusy
                Else
                    .BusyStatus = ws.Cells(r, 5).Value
                End If

                If ws.Cells(r, 6).Value > 0 Then
                    .ReminderSet = True
                    .ReminderMinutesBeforeStart = ws.Cells(r, 6).Value
                Else
                    .ReminderSet = False
                End If

                .Body = ws.Cells(r, 7).Value ' Set body of appointment
                .Save ' Save the appointment
                .Send ' Send the appointment
            End With
            ' Add "Done" status to corresponding row in column J
            ws.Cells(r, 10).Value = "Done"
        End If
        r = r + 1
    Loop

End Sub

After running the macro, it will add a Done status on column J. If you add new entries, the macro will only work on the entries without the status.

I am attaching the result file here. Try it yourself and let us know. Thank you!

Regards,
Yousuf Shovon

 

[rafaelbatalha]

Hello,

Good Afternoon.

Sorry for the late reply.

I tested the code that you wrote and now its works perfectly.
It only "reads" new entries and creates the new entries in outlook calendar.

Thank you so much for your help. Without you i could not have solved the problem.
Thank you so so much!!!!!