Macro to create Outlook appointment from excel file

[blandreth]

Let me start by saying I know nothing about writing code for macros and I do not have code to start with for what I'm looking for help with. The most I have done with macro coding is modify code for specific file paths or cell designations.

Now that I have that out of the way, I'm looking for code to run a macro that will pull a cell from an Excel file that contains a date and match that date in Outlook then create an all day appointment on this date with .5 day reminder. The subject line of the appointment would be the title of the Excel file that is shown in another cell in the form. Ultimately, I would like to run the macro so that it is run in the background without having to acknowledge anything in Outlook to create this appointment. I am currently using Office 2016. This Excel file would also be used by multiple people. I would want the macro to create the appointment in the users Outlook.

Any help would be greatly appreciated.

Thanks!

 

[blandreth]

Thanks again lrobbo314! You have been a tremendous help.

With that being said, I need help with another macro. Once I press the macro button, I need the macro to convert the active Excel sheet to a pdf file and attach it to an email to be sent to a group of people to be input by the user. The pdf does not need to be saved anywhere as I will already have a saved Excel file of the form. The attachment is for communication only. This is going in the same file you helped me with on the Outlook appointment/reminder

Please let me know if you need more information.

I appreciate your help.

 

[lrobbo314]

Let me know how this works for you.

Sub CreateAppt()
On Error GoTo erHandle
Dim ws As Worksheet
Dim olApp As Object
Dim olItem As Object
Dim olMail As Object
Dim dt As Date
Dim fName As String


dt = Range("B13").Value
Set ws = ActiveSheet
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.createItem(0)
Set olItem = olApp.createItem(1)
fName = Environ("UserProfile") & "\Desktop\tmp.pdf"


With olItem
    .Subject = Range("A1") 'Change to cell that has value for subject
    .Body = "Appointment Details" 'Can refer to another cell in sheet, i.e. range("A2")
    .ReminderMinutesBeforeStart = 12 * 60 '12 hours times 60 minutes
    .Start = dt
    .End = dt
    .AllDayEvent = True
    .Save
End With


ws.ExportAsFixedFormat xlTypePDF, fName, xlQualityStandard


With olMail
    .To = "recip1@test.com;recip2@test.com"
    .Subject = "Excel Snapshot"
    .Body = "See Attached"
    .Attachments.Add fName
    .Display
End With


Kill fName


Exit Sub




erHandle:
If Err.Number = 13 Then
    MsgBox "Active cell must containt a date", vbCritical
Else
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
End If
End Sub

 

[blandreth]

Thanks. This may be a stupid question, but I'm going to ask anyway. Is this to be incorporated with the set appointment macro? If so, I have two different macros I want to run - 2 different macro buttons. This macro is on a separate tab in the file and will email a pdf copy of this specific tab to email recipients determined by the user.

Thanks!

 

[lrobbo314]

Here are the 2 subroutines split apart.

Sub CreateAppt()
On Error GoTo erHandle
Dim olApp As Object
Dim olItem As Object
Dim dt As Date


dt = Range("B13").Value
Set olApp = CreateObject("Outlook.Application")
Set olItem = olApp.createItem(1)


With olItem
    .Subject = Range("A1") 'Change to cell that has value for subject
    .Body = "Appointment Details" 'Can refer to another cell in sheet, i.e. range("A2")
    .ReminderMinutesBeforeStart = 12 * 60 '12 hours times 60 minutes
    .Start = dt
    .End = dt
    .AllDayEvent = True
    .Save
End With


Exit Sub


erHandle:
If Err.Number = 13 Then
    MsgBox "Active cell must containt a date", vbCritical
Else
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
End If
End Sub


Sub CreateEmail()
Dim olMail As Object
Dim ws As Worksheet
Dim fName As String
Dim olApp As Object


Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.createItem(0)
Set ws = ActiveSheet
fName = Environ("UserProfile") & "\Desktop\tmp.pdf"
ws.ExportAsFixedFormat xlTypePDF, fName, xlQualityStandard


With olMail
    .To = "recip1@test.com;recip2@test.com"
    .Subject = "Excel Snapshot"
    .Body = "See Attached"
    .Attachments.Add fName
    .Display 'You can change to .Send to send email instead of displaying it
End With


Kill fName
End Sub

 

[blandreth]

That worked great. One thing - instead of naming the pdf "tmp.pdf" can I reference a cell here (L10) for the name?

You are awesome!!

 

[lrobbo314]

Sure. Change

[COLOR=#333333]fName = Environ("UserProfile") & "\Desktop\tmp.pdf"[/COLOR]

to

fName = Environ("UserProfile") & "\Desktop\" & Range("L10").Value & ".pdf"

 

[blandreth]

Worked perfectly. One more thing to ask (I hope) - can the email be marked with read receipt to verify people read the email?

Thank you so much for all of your help.

 

[lrobbo314]

Just add the .ReadReceiptRequested line in the With block as you can see below...

With olMail    .To = "recip1@test.com;recip2@test.com"
    .Subject = "Excel Snapshot"
    .Body = "See Attached"
    .Attachments.Add fName
    .ReadReceiptRequested = True
    .Display 'You can change to .Send to send email instead of displaying it
End With

 

[blandreth]

Worked like a champ.

Thank you so much!!

Have a great weekend.

 

[blandreth]

As I was testing all my macros, I realized an all day appointment with a .5 day reminder isn't going to work. How would I change the code to set a start and end time with an hour before reminder? Basically I want to start the appointment at noon and end at noon with an hour before reminder.

Thanks!