我有下面的宏,我读到的所有内容都说它应该有效,但是当我去发送电子邮件时,它返回“用户定义的类型未定义”,就在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
答案 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")