Getting pop up in outlook with vba/excel integration

ummjay

Board Regular
Joined
Oct 1, 2010
Messages
193
Hi!

I'm getting a pop up in outlook when I run vba code in excel.

"A program is trying to access email address ifnformation stored in outlook. If this is unexpected, click deny and verify your antivirus software is up to date..." it has me allow, deny, or allow access of X minutes. If I click allow, it happens every time I run the macro. Is there something I need to change to fix this?

Snippet of my code is below:

VBA Code:
 Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "<BODY style=font-size:11pt;font-family:Calibri>Hi " & FirstNameArray & "," & vbNewLine & _
"<br><BR>Thanks,</BODY>" & _
""

    'On Error Resume Next

    With OutMail
        .To = EmailArray
        .cc = ""
        .Subject = "Description"
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Display
        '.send
        '.Attachments.Add source_file
    End With

'Next

    'On Error GoTo 0
Set OutMail = Nothing
         
cleanup:
    Set OutApp = Nothing
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Hi Ummjay
I found the following as an alternative to using outlook for sending e-mail. You need to turn on reference: microsoft CDO for windows 2000 library on any machine that will run the macro.
Has the bonus of not requiring outlook be open

VBA Code:
Public Sub send_email(emailTo As String, _
                        emailFrom As String, _
                        emailSubject As String, _
                        emailMsg As String, _
                        emailToName As String, _
                        Optional emailAtt As String _
                        )
'send e-mail without the need for outlook
'need to turn on reference: microsoft CDO for windows 2000 library
   Dim NewMail As CDO.message
   Dim mailConfig As CDO.Configuration
   Dim fields As Variant
   Dim msConfigURL As String
   On Error GoTo Err:

   'early binding
   Set NewMail = New CDO.message
   Set mailConfig = New CDO.Configuration

   'load all default configurations
   mailConfig.Load -1

   Set fields = mailConfig.fields
    
   'Set All Email Properties
   With NewMail
        .From = emailFrom
        .To = emailTo
        .CC = ""
        .BCC = emailFrom
        .Subject = emailSubject
        .TextBody = emailMsg
        If emailAtt <> "" Then
            .Addattachment outFilePath & outFileName
        End If
   End With

   msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

   With fields
       .Item(msConfigURL & "/smtpusessl") = True 'Enable SSL Authentication
       .Item(msConfigURL & "/smtpauthenticate") = 1 'SMTP authentication Enabled
       .Item(msConfigURL & "/smtpserver") = "<server name>" 'Set the SMTP server details
       .Item(msConfigURL & "/smtpserverport") = <server port> 'Set the SMTP port Details
       .Item(msConfigURL & "/sendusing") = 2 'Send using default setting
       .Item(msConfigURL & "/sendusername") = emailFrom 'Your gmail address
       '.Item(msConfigURL & "/sendpassword") = "password" 'Your password or App Password
       .Update 'Update the configuration fields
   End With
   NewMail.Configuration = mailConfig
   NewMail.Send
   
   'MsgBox "Your email has been sent", vbInformation

Exit_Err:
   'Release object memory
   Set NewMail = Nothing
   Set mailConfig = Nothing
   Exit Sub

Err:
   Select Case Err.Number
   Case -2147220973 'Could be because of Internet Connection
       MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
   Case -2147220975 'Incorrect credentials User ID or password
       MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
   Case Else 'Report other errors
       MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
   End Select

   Resume Exit_Err

End Sub
 
Upvote 0
thanks, others will be sharing, and would be difficult to have each person enable this setting. I was able to get assistance elsewhere, but thank you for your help.
 
Upvote 0

Forum statistics

Threads
1,214,875
Messages
6,122,047
Members
449,064
Latest member
scottdog129

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top