mercredi 8 novembre 2017

Using checkboxes with vba in excel

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