Public Sub ジョルテ完了()
Dim objOL As Outlook.Application
Dim objOLSelect As Outlook.Selection
Dim item As AppointmentItem
Dim k As Long
Set objOL = New Outlook.Application
Set objOLSelect = objOL.ActiveExplorer.Selection
Set fso = New FileSystemObject
For k = 1 To objOLSelect.count
Set item = objOLSelect.item(k)
Debug.Print item.Subject
If InStr(1, item.Subject, " [!]") > 0 Then
item.Subject = Replace(item.Subject, " [!]", " [!/C]")
item.save
Debug.Print """ [!]""を"" [!/C]""に置換した:" & item.Subject
ElseIf InStr(1, item.Subject, "[!/C]") = 0 And _
InStr(1, item.Subject, "[C]") = 0 Then
item.Subject = item.Subject + " [C]"
item.save
Debug.Print """ [C]""を追加した:" & item.Subject
End If
Next k
End Sub
Public Sub ジョルテ未完了()
Dim objOL As Outlook.Application
Dim objOLSelect As Outlook.Selection
Dim item As AppointmentItem
Dim k As Long
Set objOL = New Outlook.Application
Set objOLSelect = objOL.ActiveExplorer.Selection
Set fso = New FileSystemObject
For k = 1 To objOLSelect.count
Set item = objOLSelect.item(k)
Debug.Print item.Subject
If InStr(1, item.Subject, " [C]") > 0 Then
item.Subject = Replace(item.Subject, " [C]", "")
item.save
Debug.Print """ [C]""を""に置換した:" & item.Subject
ElseIf InStr(1, item.Subject, " [!/C]") > 0 Then
item.Subject = Replace(item.Subject, " [!/C]", " [!]")
item.save
Debug.Print """ [!/C]を"" [!]""に置換した:" & item.Subject
End If
Next k
End Sub