スポンサーリンク

OutlookVBA ジョルテ用 完了/未完了

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
            ' [!]を[!/C]に置換
            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
            '末尾に[C]、[!/C]が無ければ「 [C]」を追加 [!]
           
           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
        
        ' 件名に" [C]"がある場合
        If InStr(1, item.Subject, " [C]") > 0 Then
            ' " [C]"を空白に置換する
            item.Subject = Replace(item.Subject, " [C]", "")
            item.save
            Debug.Print """ [C]""を""に置換した:" & item.Subject
        ElseIf InStr(1, item.Subject, " [!/C]") > 0 Then
            ' 件名に" [!/C]"がある場合
           
            '" [!/C]"を" [!]"に置換
            item.Subject = Replace(item.Subject, " [!/C]", " [!]")
            item.save
            Debug.Print """ [!/C]を"" [!]""に置換した:" & item.Subject
        End If
    Next k
End Sub