Excel data to create meeting invitation in Outlook...Almost there (I hope)

[jmcconnell]

Excel data to create meeting invitation in Outlook...Almost there (I hope)


Hi all, I know this has been tackled in various forums but I just can't quite find the answer I need. I'm fairly new to this so struggling a bit...

I'm trying to extract data from a sheet to create meeting requests. Each line on the spreadsheet will set up a new meeting invitation.

After playing around a lot, I can get it to generate meeting requests if the data is on the same sheet as the code. However, I need the code to be on a different sheet to the table itself. I also can't get it to use email addresses within the sheet....Only when I specify them in the actual code.

Here is the data I'm using: The worksheet with this table is called 'Curtailments'

Site name	Unit ID	Agent	Entity	(MW)	Start time	Start date	Cease time	Cease Date
Batsworthy Cross	ODFM44-01	TestCo1	Entity1	100	10:00	05/05/2020	16:00	05/05/2020
Denzel Downs	ODFM45-01	TestCo1	Entity1	200	11:00	05/05/2020	15:00	05/05/2020
Forss	ODFM42-01	TestCo1	Entity1	0	10:00	05/05/2020	16:00	05/05/2020
Little Raith	ODFM80-01	TestCo1	Entity1	0	11:00	05/05/2020	15:00	05/05/2020

Below is the code that's on a different sheet:

Dim OLook As Outlook.Application
Set OLook = New Outlook.Application
Dim sh As Worksheet
Set sh = sheets("Curtailments")
Dim Oapt As Outlook.AppointmentItem
Dim r As Long
Dim mylist As String
On Error Resume Next


Set Oapt = OLook.CreateItem(olAppointmentItem)
On Error GoTo 0
r = 2 ' first row with data
Oapt.MeetingStatus = olMeeting

With Oapt
  ' read appointment values from the worksheet
On Error Resume Next
Oapt.Recipients.Add ("Need to get addresses from curtailments sheet")
.Start = sh.[Cells(r, 7).Value + Cells(r, 6).Value]
.End = Cells(r, 3).Value + Cells(r, 4).Value
.Subject = Cells(r, 5).Value
.Location = Cells(r, 6).Value
.Body = "testing"
.ReminderSet = Cells(r, 7).Value
On Error GoTo 0
.Display
'.Save ' saves the new appointment to the default folder

End With
Set Oapt = Nothing
Set OLook = Nothing

End Sub

As you can see I've tried but failed miserably so any help would be very much appreciated. Thank you in advance.

 

[kennypete]

You're most of the way there. Here's code that will do the loop and add email addresses. You were missing "sh." in some places (explaining why it was not behaving when run from elsewhere other than the active sheet) and I've had to presume what you want as the start/finish, location etc., because you were using incorrect columns for much of the data (e.g. the times):

Option Explicit
Sub subCreateAppontments()

Dim OLook As Outlook.Application
Set OLook = New Outlook.Application
Dim sh As Worksheet
Set sh = Sheets("Curtailments")
Dim Oapt As Outlook.AppointmentItem
Dim r As Long
Dim mylist As String
On Error Resume Next

On Error GoTo 0
r = 2 ' first row with data
Do
    Set Oapt = OLook.CreateItem(olAppointmentItem)
    With Oapt
        .MeetingStatus = olMeeting
        On Error Resume Next
        ' read appointment values from the worksheet
        .Recipients.Add sh.Cells(r, 10).Value
        .Start = sh.Cells(r, 7).Value + sh.Cells(r, 6).Value
        .End = sh.Cells(r, 9).Value + sh.Cells(r, 8).Value
        .Subject = sh.Cells(r, 5).Value
        .Location = sh.Cells(r, 1).Value
        .Body = "testing Unit ID: " & sh.Cells(r, 2).Value
        .ReminderSet = sh.Cells(r, 7).Value
        .Subject = sh.Cells(r, 4).Value & " — " & sh.Cells(r, 2).Value
        On Error GoTo 0
        .Display
        '.Save      ' saves the new appointment to the default folder
    End With
    r = r + 1
Loop While Len(sh.Cells(r, 10).Value) > 5
Set Oapt = Nothing
Set OLook = Nothing
End Sub

Input:

Book8
	A	B	C	D	E	F	G	H	I	J
1	Site name	Unit ID	Agent	Entity	(MW)	Start time	Start date	Cease time	Cease Date	Email
2	Batsworthy Cross	ODFM44-01	TestCo1	Entity1	100	10:00	5/05/2020	16:00	5/05/2020	mofohic214@lywenw.com
3	Little Raith	ODFM80-01	TestCo1	Entity1	0	11:00	5/05/2020	15:00	5/05/2020	mofohic214@lywenw.com
Curtailments

Meeting created (the second one):

Hopefully this should put you on the right track.

 

[jmcconnell]

@kennypete Thank you very very much. That is exactly what I need.

 

[mysubkarthik]

You're most of the way there. Here's code that will do the loop and add email addresses. You were missing "sh." in some places (explaining why it was not behaving when run from elsewhere other than the active sheet) and I've had to presume what you want as the start/finish, location etc., because you were using incorrect columns for much of the data (e.g. the times):

Option Explicit
Sub subCreateAppontments()

Dim OLook As Outlook.Application
Set OLook = New Outlook.Application
Dim sh As Worksheet
Set sh = Sheets("Curtailments")
Dim Oapt As Outlook.AppointmentItem
Dim r As Long
Dim mylist As String
On Error Resume Next

On Error GoTo 0
r = 2 ' first row with data
Do
    Set Oapt = OLook.CreateItem(olAppointmentItem)
    With Oapt
        .MeetingStatus = olMeeting
        On Error Resume Next
        ' read appointment values from the worksheet
        .Recipients.Add sh.Cells(r, 10).Value
        .Start = sh.Cells(r, 7).Value + sh.Cells(r, 6).Value
        .End = sh.Cells(r, 9).Value + sh.Cells(r, 8).Value
        .Subject = sh.Cells(r, 5).Value
        .Location = sh.Cells(r, 1).Value
        .Body = "testing Unit ID: " & sh.Cells(r, 2).Value
        .ReminderSet = sh.Cells(r, 7).Value
        .Subject = sh.Cells(r, 4).Value & " — " & sh.Cells(r, 2).Value
        On Error GoTo 0
        .Display
        '.Save      ' saves the new appointment to the default folder
    End With
    r = r + 1
Loop While Len(sh.Cells(r, 10).Value) > 5
Set Oapt = Nothing
Set OLook = Nothing
End Sub

Input:

Book8
	A	B	C	D	E	F	G	H	I	J
1	Site name	Unit ID	Agent	Entity	(MW)	Start time	Start date	Cease time	Cease Date	Email
2	Batsworthy Cross	ODFM44-01	TestCo1	Entity1	100	10:00	5/05/2020	16:00	5/05/2020	mofohic214@lywenw.com
3	Little Raith	ODFM80-01	TestCo1	Entity1	0	11:00	5/05/2020	15:00	5/05/2020	mofohic214@lywenw.com
Curtailments

Meeting created (the second one):
View attachment 15140
Hopefully this should put you on the right track.

this worked fine for me.

can you help me how to add optional attendees and meeting link like ( Skype or Microsoft teams).

 

[markwphillips]

@kennypete Thank you very very much. That is exactly what I need.

Did you ever find a complete solution? Could you send me your working document?