Automatisch out of office instellen op basis van afwezigheid in agenda.

Status
Niet open voor verdere reacties.

Hamadryas

Gebruiker
Lid geworden
21 jun 2019
Berichten
24
Hey allemaal,
Ik heb al wat ervaring met VBA in Excel maar nog geen VBA ervaring in Outlook.
Ik geef momenteel in wanneer ik niet aanwezig ben in mijn agenda, maar zou graag een code hebben dat mijn out of office aangezet wordt als ik afwezig ben met de juiste datum in de tekst.
Ik vond onderstaande code wel al online maar deze doet schijnbaar niet veel maar geeft ook geen errors.

Code:
Dim oOutlook As Outlook.Application
Dim oStore As Outlook.Store
Dim oProp As Outlook.PropertyAccessor
Dim oInbox As Outlook.Folder
Dim oStorageItem As Outlook.StorageItem
Dim nms As Outlook.NameSpace
Dim oRule As Outlook.Rule, oRules As Outlook.Rules

Private Sub Application_Startup()
   SetRuleEnabled False
End Sub

Private Sub Application_Quit()
Dim iDag As Integer, iUur As Integer, Dag As Date
Dim msg As String

    Dag = Date
    iDag = Weekday(Date, vbMonday)
    iUur = CInt(Format(Now(), "hh"))
    
    If iDag >= 3 And iUur >= 11 Then
        weg = MsgBox("'Afwezigheidsassistent' instellen?", vbYesNo + vbDefaultButton1, "Afwezigheidsassistent")
        If weg = vbYes Then
        Do Until Weekday(Dag, vbMonday) = 1
            Dag = Dag + 1
        Loop
            tmp = InputBox("Ben je op " & Dag & " weer terug?" & vbLf & "Anders datum aanpassen...", "Volgende werkdag instellen", Dag)
            If tmp = "" Then
                Exit Sub
            ElseIf IsDate(tmp) Then
                Dag = tmp
            End If
        Else
            Exit Sub
        End If
        msg = "Ik ben tot " & Format(Dag, "dddd") & " " & Dag & " afwezig." & Chr(10) & Chr(13) _
            & "Voor vragen kun je mailen naar: mailadrs" & Chr(10) & Chr(13) _
            & "Met vriendelijke groet," & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
            & "Naam" & Chr(10) & Chr(13) _

    End If
   
    'OutofOffice tekst instellen.
    OutOfOffice msg
    'Regels aanzetten
    SetRuleEnabled True

End Sub

Private Function SetRuleEnabled(ByVal bEnable As Boolean)

    Set nms = Application.Session
    Set oRules = nms.DefaultStore.GetRules()
    Set oProp = nms.DefaultStore.PropertyAccessor

    'Als de Out-Of-Office aan staat (vakantie, ziek etc), kun je hem beter eerst uit zetten.
    If oProp.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x661D000B") Then
        bEnable = False
    End If
    'De Out-Of-Office instellen met de meegegeven parameter
    oProp.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x661D000B", bEnable

End Function

Public Function OutOfOffice(Tekst As String)
    
    Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
    ' Get an instance of the hidden StorageItem
    Set oStorageItem = oInbox.GetStorage("IPM.Note.Rules.OofTemplate.Microsoft", olIdentifyByMessageClass)
    oStorageItem.Body = Tekst
    oStorageItem.Save
    
    ' Cleanup
    Set oStorageItem = Nothing
    Set oInbox = Nothing
    
End Function

Is er iemand die hiermee kan helpen?
Op zich vind ik het wel handig dat hij vraagt of hij moet ingesteld worden.
Alvast bedankt!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan