Disable Outlook Security Prompt

**mcinnes01** · 03-07-2011, 08:34 AM

Hi,

I am trying to find a way that I can disable the outlook security popup when using the the outlook email script. I have had to rewrite my module which originally used CDO to email, for half of the business who I have no control over their IT.

Basically a module determines if your are using FirstClass as your default mail client, if you are it goes to the CDO script if not it goes to the Outlook mail object script using late binding.

I need to find a way that I can handle the popup as the script sends multiple emails dependant upon the submission made by the person submitting the request using my form.

I can't use anything that requires installation such as security manager and the users only have basic rights on their pc's.

**DonkeyOte** · 03-07-2011, 08:47 AM

Originally Posted by mcinnes01

I can't use anything that requires installation such as security manager and the users only have basic rights on their pc's.

In which case realistically you can't - if CDO not permitted.
(we assume reverting to a pre-security prompt SP is not viable !!)

Ron de Bruin offers a basic SendKey method but most would avoid it: http://www.rondebruin.nl/mail/prevent.htm

**mcinnes01** · 03-07-2011, 11:49 AM

Thanks donkeyote,

Unfortunately half of our users are not on our network and port 25 on our mail server does not allow external requests, which I think is standard practice to avoid relaying. The only way that could be used to overcome this would be to allow fixed IP's of the other sites to use port 25, but I don't think this is viable or whether all the sites have fixed IP's as some are very small.

I just successfully performed a test and got all the various emails as expect, but unfortunately there were 3 prompts from the security dialogue, there could be more dependant upon the number of requests submitted by the user.

I wonder is there any setting in Outlook that can disable the pop up. I think I managed it on my 2010 outlook with the DEP option, but most of the staff as far as I know use 2003. Is there a similar option in 2003 or is there any VB code that can be pasted in to a module for outlook that can disable the dialogue? I appreciate this is an excel forum, but its worth enquiring.

Cheers,

Andy

**DonkeyOte** · 03-07-2011, 12:03 PM

Originally Posted by mcinnes01

I managed it on my 2010 outlook with the DEP option, but most of the staff as far as I know use 2003. Is there a similar option in 2003 or is there any VB code that can be pasted in to a module for outlook that can disable the dialogue?

No, there is no standard functionality for 2003 that I'm aware of

Given the above I would remind anyone replying that no "hack chat" is permitted on this board.
the above is not aimed at any particular individual - just a general pre emptive reminder of policy

**romperstomper** · 03-07-2011, 12:20 PM

My recollection (and this is really not my area) is that you can build a COM add-in and have the administrator allow this to bypass the security prompts. I can't recall offhand if this has to be a .Net thing and then create a Shim or not.

**mcinnes01** · 03-11-2011, 12:55 PM

Unfortunately some of our staff are based in council offices and so we litterally cannot have anything installed on their machines as you can imagine. I have just purchased VBMAPI security evader which gives me a virtual com addin made up by a load of class libraries.

I suppose another method could have been to write an email script and have the staff add it to their outlook client and then the spreadsheet would call that, but the users have low level IT skills and I physically don't have time to talk hundreds of people through how to do this.

Do you think VBMAPI security evader will solve my issue? And also I am using their example function:

Public Function Sendmail(Optional Send_To As String, _
                           Optional Subject As String, _
                           Optional MessageBody As String, _
                           Optional Attachments As String) As Boolean

On Error GoTo ErrorHandler:

    Dim Session As vbMAPI_Session
    Dim Item As vbMAPI_MailItem
    Dim AttachmentPath As Variant
    
    ' Create the vbMAPI Session
    Set Session = vbMAPI_Init.NewSession
    
    ' Logon to the MAPI session
    Session.LogOn

    ' Create a new message
    Set Item = Session.GetDefaultFolder(FolderType_Outbox).Items.Add
    
    With Item

      .Subject = Subject
      .To_ = Send_To

      ' Set the message BODY (HTML or plain text)
      If Left(MessageBody, 6) = "<HTML>" Then
          .HTMLBody = MessageBody
      Else
          .Body = MessageBody
      End If

      ' Add any specified attachments
      For Each AttachmentPath In Split(Attachments, ";")
          AttachmentPath = Trim(AttachmentPath)
          If Len(AttachmentPath) > 0 Then
              .Attachments.Add AttachmentPath
          End If
      Next

      .Send

    End With
    
    ' Optional - force a send/receive
    Session.OutlookSendReceiveAll

    ' If we got here without error, then everything went ok.
    Sendmail = True
    
ExitRoutine:
    Exit Function
    
ErrorHandler:
    MsgBox "An error has occured in SendMail() " & vbCrLf & vbCrLf & _
            "Number: " & CStr(Err.Number) & vbCrLf & _
            "Description: " & Err.Description, vbApplicationModal
    Resume ExitRoutine

End Function

' Example of usage:

This is called from various email modules such as, the following, but I keep getting a ByRef type missmatch on the Sendmail Send_To:

Public Sub EMAILnSAVE()

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Object
    Dim Destwb As Object
    Dim cell As Long
    Dim NR As Long
    Dim wsData As Worksheet
    Dim SaveStr As String
    Dim tagerror As String
    Dim Send_To, Subject, MessageBody, Attachments
    Dim errPar As String
    Dim Deskstr As String

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
    
    Set Sourcewb = ThisWorkbook
        
        With Sourcewb
            Set wsData = .Sheets("OUTPUT")
        End With
    
    Set Destwb = Application.Workbooks.Add
        
        With Destwb.Worksheets("Sheet1")
            .Range("A1") = "EMP_ID"
            .Range("B1") = "KnownAs"
            .Range("C1") = "JobTitle"
            .Range("D1") = "LineManager"
            .Range("E1") = "ReportedSick"
            .Range("F1") = "StartDate"
            .Range("G1") = "EndDate"
            .Range("H1") = "Workdays"
            .Range("I1") = "Long Term Sick"
            .Range("J1") = "Comments"
            .Range("A2").Name = "Area"
        End With
    
            With wsData
                NR = .Cells(.Rows.Count, "A").End(xlUp).Row
                    .Range("A2:J" & NR).Copy Destination:=Destwb.Worksheets("Sheet1").Range("Area")
            End With
            
ActiveSheet.Name = "Sickness Absense Monitoring"

   If Val(Application.Version) < 12 Then
      ' You are using Excel 97-2003.
      FileExtStr = ".xls": FileFormatNum = -4143
   Else
        Select Case Sourcewb.FileFormat
        
           ' Code 51 represents the enumeration for a macro-free
           ' Excel 2007 Workbook (.xlsx).
           Case 51
                FileExtStr = ".xlsx"
                FileFormatNum = 51
                
           ' Code 52 represents the enumeration for a
           ' macro-enabled Excel 2007 Workbook (.xlsm).
           Case 52
                 FileExtStr = ".xlsm"
                 FileFormatNum = 52
           
           ' Code 56 represents the enumeration for a
           ' a legacy Excel 97-2003 Workbook (.xls).
           Case 56
                FileExtStr = ".xls"
                FileFormatNum = 56
           ' Code 50 represents the enumeration for a
           ' binary Excel 2007 Workbook (.xlsb).
            Case Else
                FileExtStr = ".xlsb"
                FileFormatNum = 50
        End Select
   End If
   
    Deskstr = CreateObject("WScript.Shell").SpecialFolders("Desktop") _
          & Application.PathSeparator & "SAM BACKUP"
    
    If Dir(Deskstr, vbDirectory) = "" Then MkDir Deskstr

SaveStr = Deskstr & Application.PathSeparator & ActiveSheet.Name _
        & " - " _
        & Environ("USERNAME") _
        & " - " _
        & Format(Now, " d-m-yy h.mm AM/PM")
    
 '-----------------------------------------------------------------------------

    Send_To = "example@email.ac.uk"
    Subject = "Sickness Absence Monitoring - OLASS " & Format(Now, "mm/yyyy") & " HOD: " & Sourcewb.Worksheets("INPUT").Range("HNAME")
    MessageBody = "MANAGERS DETAILS:" & vbNewLine & vbNewLine _
                 & Sourcewb.Worksheets("INPUT").Range("MNAME") & " - " & Sourcewb.Worksheets("INPUT").Range("EMP") _
                 & vbNewLine & vbNewLine _
                 & Sourcewb.Worksheets("INPUT").Range("JOB") & "   -   " _
                 & Sourcewb.Worksheets("INPUT").Range("SITE") & vbNewLine & vbNewLine _
                 & "DEPARTMENT - " & Sourcewb.Worksheets("INPUT").Range("dept") & "          DIVISION - " _
                 & Sourcewb.Worksheets("INPUT").Range("DIV") & vbNewLine & vbNewLine _
                 & "HEAD OF DEPARTMENT:" & vbNewLine & vbNewLine _
                 & Sourcewb.Worksheets("INPUT").Range("HNAME") & vbNewLine & vbNewLine _
                 & "QUERY DETAILS:" & vbNewLine & vbNewLine _
                 & Sourcewb.Worksheets("INPUT").Range("YNAME") & " - " & Sourcewb.Worksheets("INPUT").Range("YEMP") & vbNewLine & vbNewLine _
                 & "CONTACT NUMBER - " & Sourcewb.Worksheets("INPUT").Range("PHONE")

'-----------------------------------------------------------------------------
           

    
    With Destwb
       .SaveAs SaveStr & FileExtStr, FileFormat:=FileFormatNum
       .Close savechanges:=False
       On Error Resume Next
    End With
    
    Attachments = Deskstr & SaveStr
    
Sendmail Send_To, Subject, MessageBody, Attachments
    
    Call Module7.EMAILLIST
    
    Call Module8.EMAILCONF
        
    On Error GoTo tagerror
            
Sourcewb.Activate
    Sheets("INPUT").Select
    

clean_up:
    With Application
       .EnableEvents = True
       .ScreenUpdating = True
    End With
    Range("iCLEAR") = ""
    Exit Sub
    
tagerror:
    MsgBox "Error: (" & Err.Number & ") " & Err.Description & " at " & Err.Source, vbCritical
    Resume clean_up
    
End Sub

**romperstomper** · 03-11-2011, 12:58 PM

Change:

Dim Send_To, Subject, MessageBody, Attachments

to:

Dim Send_To As String, Subject As String, MessageBody As String, Attachments As String

**mcinnes01** · 03-11-2011, 01:21 PM

Hi

Thanks RS, that seems to work, I also tried Byval on the function but thats probably wrong. The problem I still have though is that it won't send an email and says there is a problem attaching the file specified in the attachment string.

I manage to get an email sent using your recomendation when remarking out the attachment from the code.

The error is:

2147212790
E_FILE_NOT_FOUND (0x8004220A)
File not found or is not accessible (perhaps open in another application?)

As you can see in my code the file is a new workbook that is created and closed?

**mcinnes01** · 03-14-2011, 06:09 AM

Figure out where it was failing.

Attachments = Deskstr & SaveStr

should be:

Attachments = SaveStr & FileExtStr

Thanks for the help

Disable Outlook Security Prompt

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Disable Outlook Security Prompt

Re: Disable Outlook Security Prompt

Re: Disable Outlook Security Prompt

Re: Disable Outlook Security Prompt

Re: Disable Outlook Security Prompt

Re: Disable Outlook Security Prompt

Re: Disable Outlook Security Prompt

Re: Disable Outlook Security Prompt

Re: Disable Outlook Security Prompt

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions