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

jmcconnell

New Member
Joined
Feb 2, 2019
Messages
35
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 nameUnit IDAgentEntity(MW)Start timeStart dateCease timeCease Date
Batsworthy CrossODFM44-01TestCo1Entity110010:0005/05/202016:0005/05/2020
Denzel DownsODFM45-01TestCo1Entity120011:0005/05/202015:0005/05/2020
ForssODFM42-01TestCo1Entity1010:0005/05/202016:0005/05/2020
Little RaithODFM80-01TestCo1Entity1011:0005/05/202015:0005/05/2020


Below is the code that's on a different sheet:
VBA Code:
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.
 

Some videos you may like

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

kennypete

Board Regular
Joined
Apr 19, 2008
Messages
246
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
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):

VBA Code:
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
ABCDEFGHIJ
1Site nameUnit IDAgentEntity(MW)Start timeStart dateCease timeCease DateEmail
2Batsworthy CrossODFM44-01TestCo1Entity110010:005/05/202016:005/05/2020mofohic214@lywenw.com
3Little RaithODFM80-01TestCo1Entity1011:005/05/202015:005/05/2020mofohic214@lywenw.com
Curtailments

Meeting created (the second one):
1590913936062.png

Hopefully this should put you on the right track.
 

mysubkarthik

New Member
Joined
Aug 17, 2020
Messages
1
Office Version
  1. 365
Platform
  1. Windows
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):

VBA Code:
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
ABCDEFGHIJ
1Site nameUnit IDAgentEntity(MW)Start timeStart dateCease timeCease DateEmail
2Batsworthy CrossODFM44-01TestCo1Entity110010:005/05/202016:005/05/2020mofohic214@lywenw.com
3Little RaithODFM80-01TestCo1Entity1011:005/05/202015:005/05/2020mofohic214@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).
 

Watch MrExcel Video

Forum statistics

Threads
1,127,089
Messages
5,622,643
Members
415,916
Latest member
eugenia

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top