VBA outlook宏返回编译错误

时间:2011-08-02 23:56:36

标签: vba outlook

我有下面的宏,我读到的所有内容都说它应该有效,但是当我去发送电子邮件时,它返回“用户定义的类型未定义”,就在Dim objRE As New RegExp

然而,它已定义,不确定为什么它会返回错误。任何人都可以帮忙,谢谢你。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim newMail As Outlook.MailItem
Dim recip As Outlook.Recipient
Dim isExternal As Boolean
Dim Msg As Outlook.MailItem
Dim m As Variant, em As Variant
Dim strBody As String
Dim intIn As Long
Dim intAttachCount As Integer, intStandardAttachCount As Integer
On Error GoTo handleError

'for ssMacro
Dim hforewnd As Long
Dim x As Long
Dim myOlExp As Outlook.Explorer
Dim myOlExps As Outlook.Explorers
Set myOlExps = Application.Explorers
Dim aryStates(1000) As Long

Dim itm As Outlook.MailItem
Dim vResp As Variant

Dim prompt As String


'Edit the following line if you have a signature on your email that includes images or other files. Make intStandardAttachCount equal the number of files in your signature.
intStandardAttachCount = 0

strBody = LCase(Item.Body)

intIn = InStr(1, strBody, "original message")

If intIn = 0 Then intIn = Len(strBody)

intIn = InStr(1, Left(strBody, intIn), "attach")

intAttachCount = Item.Attachments.Count

If intIn > 0 And intAttachCount <= intStandardAttachCount Then
    m = MsgBox("It appears that you mean to send an attachment," & vbCrLf & "but there is no attachment to this message." & vbCrLf & vbCrLf & "Do you still want to send?", vbQuestion + vbYesNo + vbMsgBoxSetForeground)
    If m = vbNo Then Cancel = True
End If

handleError:
If Err.Number <> 0 Then
    MsgBox "Outlook Attachment Reminder Error: " & Err.Description, vbExclamation, "Outlook Attachment Reminder Error"
End If

If IsMail(Item) Then
 Set Msg = Item
Else
 ' skip processing
 Exit Sub
End If

If Item.Class = olMail Then
Set newMail = Item

For Each recip In newMail.Recipients
If UCase(recip.AddressEntry.Type) = "SMTP" Then
isExternal = True
Exit For
End If

Next

If isExternal And Msg.Attachments.Count > intStandardAttachCount Then
 em = MsgBox("You are sending an attachment to an outside email address" & vbCrLf & "Do you want to encrypt this message?" & vbCrLf & vbCrLf & "Click YES to stop sending" & vbCrLf & "If already encrypted or don't need to, click NO to send", vbQuestions + vbYesNo + vbMsgBoxSetForeground)
 If em = vbYes Then Cancel = True
 End If
End If

Set newMail = Nothing
Set recip = Nothing

If ufnCheckRegEx(Item.Subject, prompt) Or ufnCheckRegEx(Item.Body, prompt) Then
    prompt = prompt & vbCrLf & "Are you sure you want to send it?"
    If MsgBox(prompt, vbYesNo + vbQuestion, "Social Security Warning") = vbNo Then
    Cancel = True
    End If
End If
End Sub

Function IsMail(ByVal itm As Object) As Boolean
 IsMail = (TypeName(itm) = "MailItem")
End Function

Function ufnCheckRegEx(ByVal str As String, ByRef RetStr As String) As Boolean
    Dim objRE As New RegExp
    Dim colMatches As MatchCollection
    Dim objMatch As Match

    objRE.Global = True
    objRE.IgnoreCase = True
    objRE.Multiline = True
    Dim lngCount As Long

    objRE.Pattern = "(\b[0-8][0-9][0-9]-[0-9][0-9]-[0-9][0-9][0-9][0-9]\b)|(\b[0-8][0-9][0-9]/[0-9][0-9]/[0-9][0-9][0-9][0-9]\b)|(\b[0-8][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]\b)"

    If objRE.test(str) = True Then
        Set colMatches = objRE.Execute(str)
        RetStr = "The subject or body may contain the following social security numbers:" & vbCrLf
        For Each objMatch In colMatches
            If lngCount >= 20 Then
                RetStr = RetStr & vbCrLf & "Note: There may be too many to include in this warning."
                Set objRE = Nothing
                ufnCheckRegEx = True
                Exit Function
            End If
            RetStr = RetStr & objMatch.Value & vbCrLf
            lngCount = lngCount + 1

        Next
        ufnCheckRegEx = True
    Else
        ufnCheckRegEx = False
    End If
    Set objRE = Nothing

End Function

2 个答案:

答案 0 :(得分:3)

  

但是已定义

或者是吗? objRE已定义,RegExp是什么?

工具 - &gt;参考文献,Microsoft VBScript Regular Expressions 5.5

答案 1 :(得分:0)

而不是“Dim objRE As New RegExp”使用:

Dim objRE As Object
Set objRE = CreateObject("vbscript.regexp")