PDA

View Full Version : Code that adds new appointments to Outlook



tomasmello27
11-22-2017, 12:34 PM
Good afternoon!

This is my first post here, and I`m from Brazil, so I hope that I can make myself clear.

I`m trying to write a macro that reads a table in an Excel sheet, and from that table Outlook would generate new meetings (depending on the number of rows in the table). The table is the following:

21018

The column "Compromisso" represents the subject of the meeting, "Data" represents date, "Horário" represents the time and "Informações Adicionais" represent the body of the message in the meeting.

I wrote a code with a loop that would cycle from the first to the last line, and would create meetings in every loop. However, my code is only creating the meeting contained in the last line. And what is strange is when I execute the code by parts, Outlook is creating each meeting, however in the end only the last one is saved (like the others were deleted). Was I clear? Below is my code, hope you can help me. Thanks in advance!

Sub criarcompromissotabela()


Dim r As Long


Dim O As Outlook.Application
Set O = New Outlook.Application


Dim ONS As Outlook.Namespace
Set ONS = O.GetNamespace("MAPI")


Dim pastacalendario As Outlook.Folder
Set pastacalendario = ONS.GetDefaultFolder(olFolderCalendar)


Dim compromisso As Outlook.AppointmentItem
Set compromisso = pastacalendario.Items.Add(olAppointmentItem)


r = Range("A1").CurrentRegion.Rows.Count


For i = 2 To r


With compromisso
.Start = Cells(i, 2) + Cells(i, 3)
.Subject = Cells(i, 1)
.Body = Cells(i, 4)

.Save

End With


Next i


End Sub

Kenneth Hobs
11-22-2017, 05:08 PM
Welcome to the forum! When posting code, please paste between code tags. Click the # icon on the reply toolbar to insert the tags.

Without testing, I would guess move your last Set line of code to just after your For.

tomasmello27
11-23-2017, 04:15 AM
Thank you a lot for your response Kenneth Hobs. I`ll keep that in my mind for my further interactions in the forum.

As for your suggestion, it really worked, thank you a lot!

Cheers