I set up this macro a few years ago for a complex spreadsheet my wife uses for her business. This year, we changed the name from 1_contacts_pending_2015.xls (saved in 2010 Excel format) to 1_contacts_pending_2016.xlsm (saved in 2013 Excel format). Nothing else has really changed.
The script took lots of information from the spreadsheet and sent it to her Outlook calendar, where she used all the critical information. Now with the new name (and format?), it will not work at all. I struggled to get this working a few years back and really can't figure out where to go from here. I get errors of "user defined type not defined" for the string "oOL As Outlook.Application", and probably more past that.
ANY HELP on how to make the changes to get this working. There has been no change in the Outlook program settings (any I should make?), and yes, the Outlook Library is referenced still in the tools>references section of VBA.
Thanks so much in advance.
Sub ToCalendar()
'Add reference to MS Outlook Library
Dim oOL As Outlook.Application, oAppoint As Outlook.AppointmentItem
Dim oWS As Worksheet, r As Long, i As Long, sStart As String, eEnd As String, date_time As String
Dim b1 As String, b2 As String, b3 As String, b4 As String, b5 As String, b6 As String, b7 As String, b8 As String, b9 As String, b10 As String
Dim b11 As String, b12 As String, b13 As String, b14 As String, b15 As String, b16 As String, b17 As String, b18 As String, b19 As String, b20 As String
Dim b21 As String, b22 As String, b23 As String, b24 As String, b25 As String, b26 As String, b27 As String, b28 As String, b29 As String, b30 As String
Dim oCY As Worksheet, x1 As Integer
'Set worksheet references for iCal Logic and CurrentYr
Set oWS = Sheet2
Set oCY = Sheet1a
'This next line it tied to the logic cell that has a count of the number of appointments to be sent to Outlook
r = oWS.Cells(1, 1)
Set oOL = New Outlook.Application
'Loop
For i = 2 To r
Set oAppoint = oOL.CreateItem(olAppointmentItem)
With oAppoint
'Creates a variable that is equal to the current date and tiime.
date_time = Now()
'These rows set the information for each variable "bx" which will be printed out in the body of the appointment.
b1 = "" & "Hi All, This is the newest Arioso Strings format for reminders. Please review carefully." & " "
b2 = "Gig Date" & " - " & Format(oWS.Cells(i, 24), "mmmm d, yyyy")
b3 = "Call Time" & " - " & Format(oWS.Cells(i, 25), "h:mm AM/PM")
b4 = "Please reply OK to this email or invitation, or let me know if you have questions."
b5 = "Violin 1:" & " " & oWS.Cells(i, 7) & " - " & oWS.Cells(i, 13) & " - " & oWS.Cells(i, 33)
b6 = "Violin 2:" & " " & oWS.Cells(i, 8) & " - " & oWS.Cells(i, 14) & " - " & oWS.Cells(i, 34)
b7 = "Cello:" & " " & oWS.Cells(i, 9) & " - " & oWS.Cells(i, 15) & " - " & oWS.Cells(i, 35)
b8 = "Viola:" & " " & oWS.Cells(i, 10) & " - " & oWS.Cells(i, 16) & " - " & oWS.Cells(i, 36)
b9 = "Guitar:" & " " & oWS.Cells(i, 11) & " - " & oWS.Cells(i, 17) & " - " & oWS.Cells(i, 37)
b10 = "Other:" & " " & oWS.Cells(i, 12) & " - " & oWS.Cells(i, 18) & " - " & oWS.Cells(i, 38)
b11 = "Wedding Couple:" & " - " & oWS.Cells(i, 3)
b12 = "Director/Coordinator:" & " - " & oWS.Cells(i, 19)
b13 = "Ensemble:" & " " & oWS.Cells(i, 6)
b14 = "Play Start Time:" & " " & Format(oWS.Cells(i, 26), "h:mm AM/PM")
b15 = "Play End Time:" & " " & Format(oWS.Cells(i, 27), "h:mm AM/PM")
b16 = "Event Type:" & " " & Format(oWS.Cells(i, 28), Color = RGB(255, 0, 0))
b17 = "Indoor/Outdoor:" & " " & oWS.Cells(i, 22)
b18 = "Location:" & " " & oWS.Cells(i, 20)
b19 = "Address:" & " " & oWS.Cells(i, 29)
b20 = "Map Link:" & " " & oWS.Cells(i, 30)
b21 = " If you are unfamiliar with the venue and it's location, please research their"
b22 = " website or ask me for further directions in advance!"
b23 = "Rain Location: " & oWS.Cells(i, 21)
b24 = "Bring Black heavy duty stand."
b25 = "Men: True black; straight collar dress shirt, black dress pants, black belt, black dress socks and dress shoes."
b26 = "Women: Long or calf length black, black dress shoes."
b27 = "Mary Block, Arioso Strings"
b28 = "Cell: 919-616-0418, Email: mary@ariosostrings.com"
b29 = "Updated:" & " " & Format(date_time, "mm-dd-yy, h:mm AM/PM")
.Start = oWS.Cells(i, 4)
.End = oWS.Cells(i, 5)
'This is what will show up in the appointment subject line.
.Subject = oWS.Cells(i, 51) & " " & oWS.Cells(i, 52) & " " & oWS.Cells(i, 6) & " " & oWS.Cells(i, 28) & " for " & oWS.Cells(i, 3)
'This is what will show up in the appointment location line.
.Location = oWS.Cells(i, 20)
.ResponseRequested = True
'This is what shows up in the appointment body. The code "& Chr(13)" places a line feed between each element in the body, so it does not read as a log string.
.Body = b1 & Chr(13) & Chr(13) & b2 & Chr(13) & Chr(13) & b3 & Chr(13) & Chr(13) & b4 & Chr(13) & Chr(13) & b5 & Chr(13) & b6 & Chr(13) & b7 & Chr(13) & b8 & Chr(13) & b9 & Chr(13) & b10 & Chr(13) & Chr(13) & b11 & Chr(13) & Chr(13) & b12 & Chr(13) & Chr(13) & b13 & Chr(13) & Chr(13) & b14 & Chr(13) & b15 & Chr(13) & Chr(13) & b16 & Chr(13) & b17 & Chr(13) & Chr(13) & b18 & Chr(13) & b19 & Chr(13) & b20 & Chr(13) & b21 & Chr(13) & b22 & Chr(13) & Chr(13) & b23 & Chr(13) & Chr(13) & b24 & Chr(13) & b25 & Chr(13) & b26 & Chr(13) & Chr(13) & b27 & Chr(13) & b28 & Chr(13) & Chr(13) & b29 & Chr(13) & Chr(13) & b30 & Chr(13) & Chr(13)
'This sets a default reminder of 1600 minutes which is equal to 7 days.
.ReminderMinutesBeforeStart = 1600
.MeetingStatus = olNonMeeting
.ReminderSet = True
.Save
End With
Next i
Set oOL = Nothing
'Comment out this next line if you do not want to resset the flags in column B, CurrentYear worksheet from 2 back to 1
Call Reset
End Sub
'Subroutine thata resets the flag in column B, CurrentYr worksheet after sending appointment to Outlook
Sub Reset()
Dim oWS As Worksheet, r1 As Long, i1 As Long
Dim oCY As Worksheet, x1 As Long, x2 As Long
'Worksheet with data on rows to reset
Set oWS = Sheet2
'CurrentYr worksheet where flag item will be reser from 2 to 1
Set oCY = Sheet1a
'Cell in iCal Results worksheet where it calculates how many rows flag items will be reset
r1 = oWS.Cells(1, 1)
For i1 = 2 To r1
'x1 finds the row number in CurrentYr that is being reset
x1 = oWS.Cells(2, 23)
oCY.Range("B" & x1).Value = 1
Next i1
End Sub
The script took lots of information from the spreadsheet and sent it to her Outlook calendar, where she used all the critical information. Now with the new name (and format?), it will not work at all. I struggled to get this working a few years back and really can't figure out where to go from here. I get errors of "user defined type not defined" for the string "oOL As Outlook.Application", and probably more past that.
ANY HELP on how to make the changes to get this working. There has been no change in the Outlook program settings (any I should make?), and yes, the Outlook Library is referenced still in the tools>references section of VBA.
Thanks so much in advance.
Sub ToCalendar()
'Add reference to MS Outlook Library
Dim oOL As Outlook.Application, oAppoint As Outlook.AppointmentItem
Dim oWS As Worksheet, r As Long, i As Long, sStart As String, eEnd As String, date_time As String
Dim b1 As String, b2 As String, b3 As String, b4 As String, b5 As String, b6 As String, b7 As String, b8 As String, b9 As String, b10 As String
Dim b11 As String, b12 As String, b13 As String, b14 As String, b15 As String, b16 As String, b17 As String, b18 As String, b19 As String, b20 As String
Dim b21 As String, b22 As String, b23 As String, b24 As String, b25 As String, b26 As String, b27 As String, b28 As String, b29 As String, b30 As String
Dim oCY As Worksheet, x1 As Integer
'Set worksheet references for iCal Logic and CurrentYr
Set oWS = Sheet2
Set oCY = Sheet1a
'This next line it tied to the logic cell that has a count of the number of appointments to be sent to Outlook
r = oWS.Cells(1, 1)
Set oOL = New Outlook.Application
'Loop
For i = 2 To r
Set oAppoint = oOL.CreateItem(olAppointmentItem)
With oAppoint
'Creates a variable that is equal to the current date and tiime.
date_time = Now()
'These rows set the information for each variable "bx" which will be printed out in the body of the appointment.
b1 = "" & "Hi All, This is the newest Arioso Strings format for reminders. Please review carefully." & " "
b2 = "Gig Date" & " - " & Format(oWS.Cells(i, 24), "mmmm d, yyyy")
b3 = "Call Time" & " - " & Format(oWS.Cells(i, 25), "h:mm AM/PM")
b4 = "Please reply OK to this email or invitation, or let me know if you have questions."
b5 = "Violin 1:" & " " & oWS.Cells(i, 7) & " - " & oWS.Cells(i, 13) & " - " & oWS.Cells(i, 33)
b6 = "Violin 2:" & " " & oWS.Cells(i, 8) & " - " & oWS.Cells(i, 14) & " - " & oWS.Cells(i, 34)
b7 = "Cello:" & " " & oWS.Cells(i, 9) & " - " & oWS.Cells(i, 15) & " - " & oWS.Cells(i, 35)
b8 = "Viola:" & " " & oWS.Cells(i, 10) & " - " & oWS.Cells(i, 16) & " - " & oWS.Cells(i, 36)
b9 = "Guitar:" & " " & oWS.Cells(i, 11) & " - " & oWS.Cells(i, 17) & " - " & oWS.Cells(i, 37)
b10 = "Other:" & " " & oWS.Cells(i, 12) & " - " & oWS.Cells(i, 18) & " - " & oWS.Cells(i, 38)
b11 = "Wedding Couple:" & " - " & oWS.Cells(i, 3)
b12 = "Director/Coordinator:" & " - " & oWS.Cells(i, 19)
b13 = "Ensemble:" & " " & oWS.Cells(i, 6)
b14 = "Play Start Time:" & " " & Format(oWS.Cells(i, 26), "h:mm AM/PM")
b15 = "Play End Time:" & " " & Format(oWS.Cells(i, 27), "h:mm AM/PM")
b16 = "Event Type:" & " " & Format(oWS.Cells(i, 28), Color = RGB(255, 0, 0))
b17 = "Indoor/Outdoor:" & " " & oWS.Cells(i, 22)
b18 = "Location:" & " " & oWS.Cells(i, 20)
b19 = "Address:" & " " & oWS.Cells(i, 29)
b20 = "Map Link:" & " " & oWS.Cells(i, 30)
b21 = " If you are unfamiliar with the venue and it's location, please research their"
b22 = " website or ask me for further directions in advance!"
b23 = "Rain Location: " & oWS.Cells(i, 21)
b24 = "Bring Black heavy duty stand."
b25 = "Men: True black; straight collar dress shirt, black dress pants, black belt, black dress socks and dress shoes."
b26 = "Women: Long or calf length black, black dress shoes."
b27 = "Mary Block, Arioso Strings"
b28 = "Cell: 919-616-0418, Email: mary@ariosostrings.com"
b29 = "Updated:" & " " & Format(date_time, "mm-dd-yy, h:mm AM/PM")
.Start = oWS.Cells(i, 4)
.End = oWS.Cells(i, 5)
'This is what will show up in the appointment subject line.
.Subject = oWS.Cells(i, 51) & " " & oWS.Cells(i, 52) & " " & oWS.Cells(i, 6) & " " & oWS.Cells(i, 28) & " for " & oWS.Cells(i, 3)
'This is what will show up in the appointment location line.
.Location = oWS.Cells(i, 20)
.ResponseRequested = True
'This is what shows up in the appointment body. The code "& Chr(13)" places a line feed between each element in the body, so it does not read as a log string.
.Body = b1 & Chr(13) & Chr(13) & b2 & Chr(13) & Chr(13) & b3 & Chr(13) & Chr(13) & b4 & Chr(13) & Chr(13) & b5 & Chr(13) & b6 & Chr(13) & b7 & Chr(13) & b8 & Chr(13) & b9 & Chr(13) & b10 & Chr(13) & Chr(13) & b11 & Chr(13) & Chr(13) & b12 & Chr(13) & Chr(13) & b13 & Chr(13) & Chr(13) & b14 & Chr(13) & b15 & Chr(13) & Chr(13) & b16 & Chr(13) & b17 & Chr(13) & Chr(13) & b18 & Chr(13) & b19 & Chr(13) & b20 & Chr(13) & b21 & Chr(13) & b22 & Chr(13) & Chr(13) & b23 & Chr(13) & Chr(13) & b24 & Chr(13) & b25 & Chr(13) & b26 & Chr(13) & Chr(13) & b27 & Chr(13) & b28 & Chr(13) & Chr(13) & b29 & Chr(13) & Chr(13) & b30 & Chr(13) & Chr(13)
'This sets a default reminder of 1600 minutes which is equal to 7 days.
.ReminderMinutesBeforeStart = 1600
.MeetingStatus = olNonMeeting
.ReminderSet = True
.Save
End With
Next i
Set oOL = Nothing
'Comment out this next line if you do not want to resset the flags in column B, CurrentYear worksheet from 2 back to 1
Call Reset
End Sub
'Subroutine thata resets the flag in column B, CurrentYr worksheet after sending appointment to Outlook
Sub Reset()
Dim oWS As Worksheet, r1 As Long, i1 As Long
Dim oCY As Worksheet, x1 As Long, x2 As Long
'Worksheet with data on rows to reset
Set oWS = Sheet2
'CurrentYr worksheet where flag item will be reser from 2 to 1
Set oCY = Sheet1a
'Cell in iCal Results worksheet where it calculates how many rows flag items will be reset
r1 = oWS.Cells(1, 1)
For i1 = 2 To r1
'x1 finds the row number in CurrentYr that is being reset
x1 = oWS.Cells(2, 23)
oCY.Range("B" & x1).Value = 1
Next i1
End Sub
