Office 2010 - Create Appointment from Data in Excel with specific issues

Public Function OpenWithShell(ByVal strFilePath As String) As Boolean'Author       : Ken Puls (link removed as per forum rules)
'Macro Purpose: To open any file in the appropriate application
    'Test for file existence to avoid Windows error message
    If Not Dir(strFilePath) = vbNullString Then
        'Open the file
        Shell ("RunDLL32.EXE shell32.dll,ShellExec_RunDLL " & strFilePath)
        OpenWithShell = True
    End If
End Function


Sub OpenFileExample()
'Author       : Ken Puls (link removed as per forum rules)
'Macro Purpose: To demonstrate the use of the OpenWithShell function
    Dim strFullFileName As String
    
    'Set path to file
    strFullFileName = "E:\My Programs\My Data\1 Outlook 2010\Outlook Resources\Extra Outlook\IRIS - Admin.bat"
    
    'Check if file opened
    If OpenWithShell(strFullFileName) = False Then _
        MsgBox ("File not opened!")
End Sub




Sub SetAppt()
    Dim olApp As Outlook.Application
    Dim olApt As AppointmentItem
    Dim MySheet As Worksheet
    
    Set MySheet = Worksheets("sql all 20131228")
    Set olApp = New Outlook.Application
    Set olApt = olApp.CreateItem(olAppointmentItem)
        
    With olApt
        .Start = Range("n8")
        .Subject = "EOM Reports #1"
        .Location = "Office"
        .Body = "Start of Month, EOM Reports"
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 60
        .Categories = "Acc - 1st Report"
        'Becomes: "Acc - EOM Final" when 2nd appointment runs'
        .ReminderSet = True
        .Save
    End With


    Set olApt = Nothing
    Set olApp = Nothing


End Sub