VB 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

无论它是如何定义的

是吗?
定义了objRE,那么RegExp呢?

Tools -> References, Microsoft VBScript Regular Expressions 5.5 .

代替"Dim objRE As New RegExp"使用:

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

最新更新