VB outlook macro returns compile error
I have the macro below, everything I read states it should work, but when I go to send an email it returns a "User defined type not defined", right at the line Dim objRE As New RegExp
However it is defined, not sure why it returns the error. Can anyone help, thank you.
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.Co开发者_Go百科unt
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
However it is defined
Or is it?
objRE
is defined, what about RegExp
?
Tools -> References, Microsoft VBScript Regular Expressions 5.5
.
Instead of "Dim objRE As New RegExp" use:
Dim objRE As Object
Set objRE = CreateObject("vbscript.regexp")
精彩评论