From Outlook client:
Script
Sub FixCopy()
Dim calendar As MAPIFolder
Dim calItem As Object
Set calendar = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
Dim iItemsUpdated As Integer
Dim strTemp As String
iItemsUpdated = 0
For Each calItem In calendar.Items
If Mid(calItem.Subject, 1, 6) = "Copy: " Then
strTemp = Mid(calItem.Subject, 7, Len(calItem.Subject) - 6)
calItem.Subject = strTemp
iItemsUpdated = iItemsUpdated + 1
End If
calItem.Save
Next calItem
MsgBox iItemsUpdated & " of " & calendar.Items.count & " Items Updated"
End Sub
- Press Alt+F11 which will open the VBA window.
- In the left pane, navigate to Project1-MS Outlook Object and double-click 'ThisOutlookSession'.
- Paste the code into the window in the right pane.
- Press the green arrow button to execute the code.
Script
Sub FixCopy()
Dim calendar As MAPIFolder
Dim calItem As Object
Set calendar = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
Dim iItemsUpdated As Integer
Dim strTemp As String
iItemsUpdated = 0
For Each calItem In calendar.Items
If Mid(calItem.Subject, 1, 6) = "Copy: " Then
strTemp = Mid(calItem.Subject, 7, Len(calItem.Subject) - 6)
calItem.Subject = strTemp
iItemsUpdated = iItemsUpdated + 1
End If
calItem.Save
Next calItem
MsgBox iItemsUpdated & " of " & calendar.Items.count & " Items Updated"
End Sub
No comments:
Post a Comment