Thursday, August 8, 2013

Change your Outlook Microsoft style...

Private Sub Application_ItemSend(ByVal Item As Object, _
                                 Cancel As Boolean)

' Place this VBA code in the built-in ThisOutlookSession module
' to send yourself a BC email every time you email.

    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next

    ' #### USER OPTIONS ####
    ' address for Bcc -- must be SMTP address or resolvable
    ' to a name in the address book
    strBcc = "someone@somewhere.dom"

    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC
    If Not objRecip.Resolve Then
        strMsg = "Could not resolve the Bcc recipient. " & _
                 "Do you want still to send the message?"
        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                "Could Not Resolve Bcc Recipient")
        If res = vbNo Then
            Cancel = True
        End If
    End If

    Set objRecip = Nothing
End Sub

##################################################################

Sub ExportICal()

' Export your calendar for Google

    Dim oNamespace As NameSpace
    Dim oFolder As Folder
    Dim oCalendarSharing As CalendarSharing
    Dim enviro As String
        enviro = CStr(Environ("USERPROFILE"))
        strFolderpath = enviro & "\Desktop\OutlookWorkCalendar.ics"

    ' Get a reference to the Calendar default folder
    Set oNamespace = Application.GetNamespace("MAPI")
    Set oFolder = oNamespace.GetDefaultFolder(olFolderCalendar)
    ' Get a CalendarSharing object for the Calendar default folder.
    Set oCalendarSharing = oFolder.GetCalendarExporter
    ' Set the CalendarSharing object to export the contents of
    ' the entire Calendar folder, excluding attachments and
    ' private items, and restricted to working hours in full detail.
    With oCalendarSharing

        .CalendarDetail = olFullDetails
        .IncludeWholeCalendar = True
        .IncludeAttachments = False
        .IncludePrivateDetails = False
        .RestrictToWorkingHours = False
    End With

    ' Export calendar to an iCalendar calendar (.ics) file.
    oCalendarSharing.SaveAsICal strFolderpath
EndRoutine:
    On Error GoTo 0
    Set oCalendarSharing = Nothing
    Set oFolder = Nothing
    Set oNamespace = Nothing
    MsgBox "'OutlookWorkCalendar.ics' Export Complete", vbOKOnly, "iCal Message"
Exit Sub


No comments:

Post a Comment