Email without Outlook

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
645
Hello,

I have a current piece of code that I use to email a pdf version of the active sheet in my open excel workbook. However, I run into two issues:
1. Outlook requires, with the PDF attachment, the user click a allow/deny dialog box because there's a potentially harmful attachment. If a user denies unknowingly, the report isn't sent.
2. Occasionally outlook doesn't actually send the email for maybe 30 minutes, maybe an hour (it's not consistent).

As such, I am trying to get around 1. Having to rely on the user actually hitting "allow" and the reliabilities of outlook. A friend suggested a piece of code below, but the IP address is a problem...I need the system to autodetect instead of manually inputting an IP.

Anyone have recommendations?

VBA Code:
'Current active code
Public Sub Email_Active_Sheet()

    Dim OutApp As Object, OutMail As Object
    Dim emailSubject As String, bodyText As String, toEmailAddresses As String
    Dim cell As Range, printRange As Range
    Dim TempFileName As String
    Dim name As String
    name = Sheets("Notes").Range("N4")
       
    'Sets parameters of email
    With ThisWorkbook.Worksheets("Notes")
        emailSubject = .Range("L45").Value
        bodyText = .Range("L46").Value
        toEmailAddresses = ""
       
        For Each cell In .Range("L37:L43")
            If cell.Value = "" Then
                Exit Sub
            Else: If cell.Value Like "?*@?*.?*" Then toEmailAddresses = toEmailAddresses & cell.Value & ";"
            End If
        Next
    End With
   
    'sets active sheet type (pdf)
    With ThisWorkbook.ActiveSheet
       
        TempFileName = Environ("temp") & "\" & .name & " Report " & Format(Now, "dd-mmm-yy") & ".pdf"
    'Check Print Range
        Call dailyprintarea
        If .PageSetup.PrintArea = vbNullString Then
            MsgBox (Environ("temp") & "\" & .name & " Report " & Format(Now, "dd-mmm-yy") & ".pdf")
            MsgBox "You must first set the Print Area(s) on the '" & .name & "' sheet.", vbExclamation, name
            Exit Sub
        End If
    'Continue with email piece
        Set printRange = Range(.PageSetup.PrintArea)
       
        printRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFileName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
           
    End With
   
    'sets outlook to run
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    'On Error Resume Next
    With OutMail
        .To = Left(toEmailAddresses, Len(toEmailAddresses) - 1)
        .CC = ""
        .BCC = ""
        .Subject = emailSubject
        .Body = bodyText
        .Attachments.Add TempFileName
        .Send
    End With
    'On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
   
    Kill TempFileName

End Sub

VBA Code:
'suggested new code
Sub cdo_mail()

Dim oEmail as Object
Set oEmail = CreateObject("CDO.Message")

With oEmail
    .From = "chiefeng@santorini.osgship.com"
    .To = "chiefeng@santorini.osgship.com"
   
    .AddAttachment "C:\Users\ChiefEng\Desktop\acceptedtable.pdf"
    .Subject = "E-Mail Subject"
   
    .Textbody = "Here you are CodeMan...hope this helps" & _
                vbNewLine & vbNewLine & "This is another line" & vbNewLine & _
                vbNewLine & "Yep, aren't you happy?"
   
    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "10.0.0.1"
'This is my issue line   
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/authenticate") = 1
    .Configuration.Fields.Update
   
    .Send
End With

   
Set oEmail = Nothing

End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
645
If you look at that page, its code is along the same line as what I have above. The issue with it is that it requires the server input (As I had running above "10.0.0.1"). However, I need it to work without someone manually inputting the code.
 

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,813
Office Version
  1. 2010
Platform
  1. Windows
I don't see server input as a problem. You can use "smtp.googlemail.com" as the mail server. The following is the actual code I use except username and password. You can create a common email account so everybody uses the same account to send mail.

VBA Code:
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "myaccount@gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.googlemail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Update
End With
 

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
645

ADVERTISEMENT

But what I'm trying to say is the requirement of setting the email server is the problem.
The code works perfectly with the 10.0.0.1 that I'm running. However, I need it to work without having to change my router address for each change, and I need to not use the internet as the LANs that this system operates on spend a fair bit of time without internet. While their addressing schemes should all be the same, they may not be at times...does that make sense?
 

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,813
Office Version
  1. 2010
Platform
  1. Windows
Not sure how your network works. On the second thought, is there a way in Outlook to do "Application.DisplayAlerts=False"? I don't use Outlook. So, not sure what are available in Outlook.
 

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
645
To answer, no, you can't use an application.displayalerts=False line. Tried it in a multitude of spots and the outlook message still pops up.

regarding the network, the reason I've been playing with this is because when I go from one LAN to another, the routers may not be serving the same address. As such, I need it still work, and it needs to work from within the LAN.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,829
Messages
5,598,343
Members
414,232
Latest member
MIA10_KO

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
Top