1

以下のコードを使用して、Access VBA から Outlook カレンダーの将来の予定を削除しようとしています。コードは正常に動作しますが、これらの予定は部屋 (リソース) を使用して設定されており、MY カレンダーで予定を削除しても、リソース カレンダーでは削除されません。どうすれば修正できますか？

Sub NoFuture()
    'delete any future appointment
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.NameSpace
    Dim olRecItems
    Dim olFilterRecItems
    Dim olItem As Outlook.AppointmentItem, strFilter As String

    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    Set olRecItems = olNs.GetDefaultFolder(olFolderCalendar)

    strFilter = "[Start] > '" & Format(Date + 1, "mm/dd/yyyy") & "'"
    Set olFilterRecItems = olRecItems.Items.Restrict(strFilter)

    For Each olItem In olFilterRecItems
        olItem.Delete
    Next olItem
    Set olRecItems = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
End Sub
4

1 に答える 1

1

Diane Poremskyは、リソース カレンダーからキャンセルされた予定を調べて削除するマクロを作成しました。

' A subroutine to remove cancelled appointments.
Sub RemoveCanceledAppointments()  

'Form variables.
Dim OutLookResourceCalendar As Outlook.MAPIFolder, OutLookAppointmentItem As Outlook.AppointmentItem, IntegerCounter As Integer 

'This sets the path to the resource calender.
Set OutLookResourceCalendar = OpenMAPIFolder("\MailboxName\Calendar")  
For IntegerCounter = OutLookResourceCalendar.Items.Count To 1 Step -1  

Set OutLookAppointmentItem = OutLookResourceCalendar.Items(IntegerCounter)  

    If Left(OutLookAppointmentItem.Subject, 9) = "Canceled:" Then 

        OutLookAppointmentItem.Delete  

    End If 

Next 

Set OutLookAppointmentItem = Nothing 

Set OutLookResourceCalendar = Nothing 

End Sub 

 ' A function for the folder path.
Function OpenMAPIFolder(FolderPathVar)  

Dim SelectedApplication, FolderNameSpace, SelectedFolder, FolderDirectoryVar, i  

Set SelectedFolder = Nothing 

Set SelectedApplication = CreateObject("Outlook.Application")  
If Left(FolderPathVar, Len("\")) = "\" Then 

    FolderPathVar = Mid(FolderPathVar, Len("\") + 1)  

Else 

    Set SelectedFolder = SelectedApplication.ActiveExplorer.CurrentFolder  

End If 

While FolderPathVar <> "" 

' Backslash var.
i = InStr(FolderPathVar, "\")  

        'If a Backslash is present, acquire the directory path and the folder path...[i].
        If i Then 

            FolderDirectoryVar = Left(FolderPathVar, i - 1)  

            FolderPathVar = Mid(FolderPathVar, i + Len("\"))  

        Else 

            '[i] ...or set the path to nothing.
            FolderDirectoryVar = FolderPathVar  

            FolderPathVar = "" 

        End If 

        ' Retrieves the folder name space from the Outlook namespace, unless a folder exists... [ii].
        If IsNothing(SelectedFolder) Then 

            Set FolderNameSpace = SelectedApplication.GetNamespace("MAPI")  

            Set SelectedFolder = FolderNameSpace.Folders(FolderDirectoryVar)  

        Else 

        ' [ii] in which case the the existing folder namespace is used.
            Set SelectedFolder = SelectedFolder.Folders(FolderDirectoryVar)  

        End If 

    Wend  

Set OpenMAPIFolder = SelectedFolder  

End Function 


 ' A function to check too see if there is no set namespace for the folder path.
Function IsNothing(Obj)  

If TypeName(Obj) = "Nothing" Then 

    IsNothing = True 

Else 

    IsNothing = False 

End If 

End Function

リソースカレンダーからキャンセルされた予定が削除されるかどうか教えてください -

~JOL

于 2012-07-27T18:21:15.543 に答える