Email without Outlook

[sassriverrat]

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?

'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

'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

 

[yky]

Check out this page:

Sending mail from Excel with CDO

 

[sassriverrat]

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]

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.

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]

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]

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]

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.