Just to start, I am in the process of teaching myself vba on the fly just so I can get a spreadsheet up and running for my department. I understand logic but I don't really have a programming background so I don't know the basic rules of vba so I can't figure out where my error is coming from. (I also know I might have some unused variables in this)
What I have: I have my spreadsheet set up with columns for Project Name, Location, Tech Name, Tech Email, Date, Start Time, Duration, Checkbox. Each row would be a new project.
What I want to do: When the box is checked: I need the code to see if the meeting happens to exist.
If it does then I need it to give a message box that it exists and NOT create a duplicate meeting.
If it does not exist, I need it to create the meeting and send the meeting invite to the Tech.
If the box is unchecked I need it to cancel the meeting if its still on the calendar. If the meeting had been deleted directly from Outlook already then I need it to ignore the cancel meeting section.
Sub TASKSCHEDULER_PCM()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Projects")
Dim o As Outlook.Application
Set o = New Outlook.Application
Dim oNS As Outlook.Namespace
Set oNS = o.GetNamespace("MAPI")
Dim FOL As Outlook.MAPIFolder
Set FOL = oNS.GetDefaultFolder(olFolderCalendar).Folders("Tech PM Test")
Dim bxstate As Boolean
bxstate = ws.CheckBoxes(Application.Caller)
Dim oAPT As Outlook.AppointmentItem
Dim oAPT_DATE As Date
Dim oAPT_TIME As Date
Dim oMTG As Outlook.MeetingItem
Dim oOBJECT As Object
Dim b As CheckBox
Dim i As Integer
Set b = ws.CheckBoxes(Application.Caller)
With b.TopLeftCell
i = .Row
End With
Dim pcmt As String
Dim pcmd As String
Dim pcmst As String
Dim pcmdur As String
'Verify data has been entered into all fields needed - works
If IsEmpty(ws.Cells(i, 12)) Then
pcmt = "Technician" & vbCrLf
Else
pcmt = ""
End If
If IsEmpty(ws.Cells(i, 14)) Then
pcmd = "Date" & vbCrLf
Else
pcmd = ""
End If
If IsEmpty(ws.Cells(i, 15)) Then
pcmst = "Start Time" & vbCrLf
Else
pcmst = ""
End If
If IsEmpty(ws.Cells(i, 16)) Then
pcmdur = "Duration" & vbCrLf
Else
pcmdur = ""
End If
'End field verify
'Error Box if schedule box is checked with missing fields - works
If b.Value = 1 Then
If IsEmpty(ws.Cells(i, 12)) Or IsEmpty(ws.Cells(i, 14)) Or IsEmpty(ws.Cells(i, 15)) Or IsEmpty(ws.Cells(i, 16)) Then
MsgBox "Missing Fields: " & vbCrLf & vbCrLf & pcmt & pcmd & pcmst & pcmdur
b.Value = 0
Exit Sub
Else
End If
Else
End If
'End Error Box
Dim createapt As Boolean
createapt = True
Dim cancelledmtg As Boolean
cancelledmtg = False
'meeting creation/cancellation loop
If bxstate = True Then 'If box is checked, does meeting already exist, if yes skip create meeting and give error box, if no create new meeting
For Each oOBJECT In FOL.Items
If oOBJECT.Class = olAppointment Then
Set oAPT = oOBJECT
oAPT_DATE = Format(oAPT.Start, "MM-DD-YYYY")
oAPT_TIME = TimeValue(oAPT.Start)
If oAPT_DATE = ws.Cells(i, 14) And oAPT.Subject = ws.Cells(i, 1) And oAPT_TIME = ws.Cells(i, 15) Then
createapt = False
Else
End If
End If
Next oOBJECT
Else 'if box is unchecked, does meeting exist, if yes cancel meeting, if no do nothing
For Each oOBJECT In FOL.Items
If oOBJECT.Class = olAppointment Then
Set oAPT = oOBJECT
oAPT_DATE = Format(oAPT.Start, "MM-DD-YYYY")
oAPT_TIME = TimeValue(oAPT.Start)
If oAPT_DATE = ws.Cells(i, 14) And oAPT.Subject = ws.Cells(i, 1) And oAPT_TIME = ws.Cells(i, 15) Then
oAPT.MeetingStatus = olMeetingCanceled
oAPT.Save
oAPT.Send
oAPT.Delete
Else
End If
End If
Next oOBJECT
Exit Sub
End If
'end meeting creation/cancellation loop
'creates meeting
If createapt = True Then
Set oAPT = FOL.Items.Add(olAppointmentItem)
With oAPT
.Start = ws.Cells(i, 14).Value + ws.Cells(i, 15).Value
.Duration = ws.Cells(i, 16).Value * 60
.Subject = ws.Cells(i, 1).Value
.Body = "Project: " & ws.Cells(i, 1).Value & vbCrLf & "Location: " & ws.Cells(i, 2) & vbCrLf & "OASIS#: " & ws.Cells(i, 3) & vbCrLf & "Project Manager: " & ws.Cells(i, 5) & vbCrLf & "Distributor: " & ws.Cells(i, 8) & vbCrLf & "Assigned Technitian: " & ws.Cells(i, 12) & vbCrLf & "Date: " & ws.Cells(i, 14) & vbCrLf & "Start Time: " & ws.Cells(i, 15) & vbCrLf & "Duration: " & ws.Cells(i, 16) & " Hours"
.Location = ws.Cells(i, 2).Value
.Recipients.Add Cells(i, 13).Value
.MeetingStatus = olMeeting
.ReminderMinutesBeforeStart = 1440
.Save
.Send
End With
Else
End If
End Sub
Right now the issue seems to be that it will create the meeting and it will not create a duplicate meeting but if I uncheck the box it will not cancel it....
Aucun commentaire:
Enregistrer un commentaire