Link to home
Create AccountLog in
Avatar of finance_teacher
finance_teacher

asked on

Outlook -- Macro Installer ?

Does someone have an installer (.exe, etc) so I don't have to tell users to do the below ?
---------------------
Current Steps
 1. Open Outlook
 2. click "Tools"
 3. click "Macro"
 4. click "Visual Basic Editor"
 5. paste below
 6. save
---------------------
Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim arrWords As Variant
Dim strWord As Variant
Dim intResponse As Integer
Dim lngSigStart As Long
Dim lngWordStart As Long
Dim sigblockidentifier As String
'    toMe item
   
    sigblockidentifier = "" ' A block of text that signifies the start of the sig block
    arrWords = Array("enclosed", "attach", "attached", "attachment")
    If sigblockidentifier <> "" Then
        lngSigStart = InStr(1, Item.Body, sigblockidentifier, vbTextCompare)
    End If
    If lngSigStart = 0 Then lngSigStart = 1000000
    Select Case Item.Class
        Case olMail ', olMeetingRequest, olTaskRequest
            If Item.Sent = False Then
                For Each strWord In arrWords
                    lngWordStart = InStr(1, LCase(Item.Body), strWord)
                    If lngWordStart > 0 And lngWordStart < lngSigStart Then
                        If Item.Attachments.Count = 0 Then
                            intResponse = MsgBox("Did you forget to attach something?  I " & _
                                "found the word '" & strWord & "'" & Chr(10) & "in your " & _
                                "message, but there is no attachment." & Chr(10) & Chr(10) & _
                                "Click Yes to stop the mail and add an attachment.", _
                                vbYesNo + vbExclamation, "Attachment Check")
   
                            If intResponse = vbYes Then
                                Item.GetInspector.CommandBars.FindControl(msoControlButton, 1079).Execute
                                Exit For
                            End If
                        End If
                        Exit For
                    End If
                Next
               
                ' Check for blank subject
                If Trim(Item.Subject) = "" Then
                    intResponse = MsgBox("You did not put in a subject.  Send anyway?", _
                        vbInformation + vbYesNo, "Subject Check")
                    If intResponse <> vbYes Then Cancel = True
                End If
            End If
    End Select
End Sub
ASKER CERTIFIED SOLUTION
Avatar of David Lee
David Lee
Flag of United States of America image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account