Entering sending options with different provider. (no outlook)

[stefanoste78]

I would like to ask you if you could improve this macro which is good for sheet 1.
The arranged macro must be applied according to the settings of sheet 2 which, unlike sheet 1, allows the possibility of:
1) select the path to the folder containing the files to be attached (as is normally done when the files are attached);
2) to be able to insert the sending options (first table on the right) to be applied to the individual emails of the second table on the right;
3) be able to indicate the list of emails to be used for sending with the related settings (server and port). This would avoid having to enter the access data to each sending email.
You could add other elements to make the macro more complete.
Thank you

 

[stefanoste78]

Hello
are there any solutions?
Thank you

 

[Kenneth Hobson]

I am not sure what the question is. I guess there are several things that you are asking which is confusing.

For (1), I guess something like:

Sub test_GetFolder()
  MsgBox Get_Folder(ThisWorkbook.path, "Folder Picker")
End Sub
Function Get_Folder(Optional FolderPath As String, _
  Optional HeaderMsg As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If FolderPath = "" Then
          .initialFilename = Application.DefaultFilePath
          Else
          .initialFilename = FolderPath
        End If
        .Title = HeaderMsg
        If .show = -1 Then
            Get_Folder = .SelectedItems(1)
        Else
            Get_Folder = ""
        End If
    End With
End Function

I guess to improve it, I would send the routine a range for 1 or more attachments and iterate that range.

I have used CDO for Gmail. You have to be sure to set security low in Gmail as I commented. I don't know about the others.

'http://www.rondebruin.nl/win/s1/cdo.htm
'http://www.learnexcelmacro.com/wp/2011/12/how-to-send-an-email-using-excel-macro-from-gmail-or-yahoo/
'https://www.youtube.com/watch?v=pFl7W8d7d4M
'http://www.blueclaw-db.com/access_email_gmail.htm

'cdo methods and properties or options, those shown by early binding but more detail:
'https://msdn.microsoft.com/en-us/library/ms872547%28EXCHG.65%29.aspx?f=255&MSPPError=-2147217396

'http://www.mrexcel.com/forum/excel-questions/905304-help-cdo.html
Sub Main()
  Dim r As Range, c As Range
  Dim sTo As String
 
  Set r = Worksheets("Sheet1").Range("B7:C25")
  For Each c In r
    With c
      If InStr(.Value2, "@") <> 0 Then sTo = sTo & "," & .Value2
    End With
  Next c
 
  If sTo = "" Then
    MsgBox sTo, vbCritical, "Ending Macro - Missing email(s)"
    Exit Sub
  End If
 
  sTo = Right(sTo, Len(sTo) - 1)
 
  Gmail "ken@gmail.com", "Ken", _
    "Subject", _
    "Body", _
    sTo, _
    "noone@nowhere.com"
End Sub


Sub Test_Gmail()
  Gmail "ken@gmail.com", "ken", "Hello World!", _
    "This is a test using CDO to send Gmail with an attachement.", _
    "khobson@somewhere.org", "YourFriendlyNeighborhoodSpiderman@spidey.com", _
    "x:\test\test.xlsm"
End Sub

' http://www.blueclaw-db.com/access_email_gmail.htm
' http://msdn.microsoft.com/en-us/library/ms872547%28EXCHG.65%29.aspx
' Add CDO reference for early binding method
'  Tools > References > Microsoft CDO for Windows 2000 Library
'    c:\windows\system32\cdosys.dll
' http://www.rondebruin.nl/cdo.htm  'Other cdo tips for cdo to Outlook from Excel

'CDO to gmail requires lowering your security:
'https://myaccount.google.com/security#connectedapps
'at the end set, Allow less secure apps: ON

Function Gmail(sendUsername As String, sendPassword As String, subject As String, _
  textBody As String, sendTo As String, sendFrom As String, _
  Optional sAttachment As String = "")
 
  Dim cdomsg As New CDO.Message  'early binding method
  'set cdomsg=new CDO.Message 'early binding only
  'Dim cdomsg As Object 'late binding method
  Set cdomsg = CreateObject("CDO.message")  'late binding method or early binding
  With cdomsg.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 25  '25 or 587
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = sendUsername
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sendPassword
    .Update
  End With
  ' build email parts
  With cdomsg
    .To = sendTo
    .From = sendFrom
    .subject = subject
    .textBody = textBody
    '.BCC
    '.CC
    '.ReplyTo = sendFrom
    '.HTMLBody
    '.HTMLBodyPart
    If Dir(sAttachment) = "" Then sAttachment = ""
    If sAttachment <> "" Then .AddAttachment (sAttachment)
    .Send
  End With
  Set cdomsg = Nothing
End Function

 

[stefanoste78]

Hello. I'll tell you about the macro.

In sheet 1, it is now possible to enter the name of the person sending the email (column b) and it is possible to insert several lines (thus sending multiple emails).

The next step is to adapt the macro of sheet 1 to the situation of sheet 2 which provides for the possibility to choose sending options which will be indicated in the appropriate table "to the right of sheet 2". These sending conditions will be valid for each e-mail to be inserted in the table below those of the options.

Another improvement situation is the ability to automatically create the path of attachments with the ability to choose the folder containing the files to be attached to each email (in this way those who do not know how to create the path by hand can do it automatically).

If you can improve the macro you will make a notable contribution.

Thank you