Sửa code cho Outlook

[bomberman211]

Chào các anh chị em, mình có sử dụng đoạn code sau trên Outlook để loại bỏ tiền tố "RE:", "FW:" khi phản hồi hoặc chuyển tiếp email (code mình chôm trên mạng về). Giờ mình muốn thêm 1 nút Cancel bên cạnh Yes và No trong hộp thoại để khi chọn Cancel thì mail không gửi đi nữa, quay lại màn hình soạn thư. Mong mọi người giúp đỡ.

Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim strSubject As String
    strSubject = Item.Subject
    If InStr(Item.Subject, "RE:") > 0 Then
       If MsgBox("Do you want to remove the prefix 'RE:'?", vbYesNo) = vbYes Then
          strSubject = Replace(Item.Subject, "RE:", "", vbTextCompare)
       Else
          strSubject = Item.Subject
       End If
    End If
    If InStr(Item.Subject, "FW:") > 0 Then
       If MsgBox("Do you want to remove the prefix 'FW:'?", vbYesNo) = vbYes Then
          strSubject = Replace(Item.Subject, "FW:", "", vbTextCompare)
       Else
          strSubject = Item.Subject
       End If
    End If
    Item.Subject = Trim(strSubject)
    Item.Save
End Sub

 

[befaint]

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Const str_RE = "RE:"
    Const str_FW = "FW:"
    Dim strSubject As String
    Dim msgResult As VbMsgBoxResult, lngMatch As Long
    
    strSubject = Item.Subject
    
    lngMatch = InStr(1, strSubject, str_RE, vbTextCompare) + InStr(1, strSubject, str_FW, vbTextCompare)
    
    If lngMatch > 0 Then
        msgResult = MsgBox("Do you want to remove the prefix [RE:, FW:] ?", vbYesNoCancel, "Msg Box")
        'case 1: Cancel
        If msgResult = vbCancel Then
            Cancel = True
            Exit Sub
        End If
        'case 2: Yes
        If msgResult = vbYes Then
            strSubject = Replace(Replace(strSubject, str_RE, "", , , vbTextCompare), str_FW, "", , , vbTextCompare)
        End If
    End If
    Item.Subject = Trim(strSubject)
    Item.Save
End Sub

 

[bomberman211]

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Const str_RE = "RE:"
    Const str_FW = "FW:"
    Dim strSubject As String
    Dim msgResult As VbMsgBoxResult, lngMatch As Long
   
    strSubject = Item.Subject
   
    lngMatch = InStr(1, strSubject, str_RE, vbTextCompare) + InStr(1, strSubject, str_FW, vbTextCompare)
   
    If lngMatch > 0 Then
        msgResult = MsgBox("Do you want to remove the prefix [RE:, FW:] ?", vbYesNoCancel, "Msg Box")
        'case 1: Cancel
        If msgResult = vbCancel Then
            Cancel = True
            Exit Sub
        End If
        'case 2: Yes
        If msgResult = vbYes Then
            strSubject = Replace(Replace(strSubject, str_RE, "", , , vbTextCompare), str_FW, "", , , vbTextCompare)
        End If
    End If
    Item.Subject = Trim(strSubject)
    Item.Save
End Sub

Đúng cái mình cần rồi, cám ơn bạn nhiều.