Ciao a tutti,
il presente post proviene da una domanda in
IalWeb.
Uso con successo il seguente codice per l'invio
senza l'utilizzo di Outlook, di mail da indirizzo gmail a indirizzo gmail, allegando il foglio attivo (NB: in A1 ci deve essere l'indirizzo del mittente):
Sub GMAIL_SendEmail()
Dim CDO_Mail_Object As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim Email_Send_From As String, Email_Send_To As String, Email_Cc As String
Dim Email_Bcc As String, Email_Subject As String, Email_Body As String
Dim Sourcewb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim sh As Worksheet
Dim wb As Workbook
Set Sourcewb = ThisWorkbook
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
On Error GoTo debugs
Set CDO_Mail_Object = CreateObject("CDO.Message")
Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1
Set SMTP_Config = CDO_Config.Fields
With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 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") = "Domenico@gmail.com" '<<<<<>>>>>>
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MiaPassword" '<<<<<>>>>>>
.Update
End With
Set sh = Worksheets("Sheet1")
sh.Copy
Set wb = ActiveWorkbook
TempFileName = "Allegato"
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close savechanges:=False
End With
Email_Subject = "Esempio"
Email_Send_From = Range("A1")
Email_Send_To = "Pippo@gmail.com" ''<<<<<>>>>>>
Email_Body = "Cari saluti"
With CDO_Mail_Object
Set .Configuration = CDO_Config
End With
CDO_Mail_Object.Subject = Email_Subject
CDO_Mail_Object.From = Email_Send_From
CDO_Mail_Object.To = Email_Send_To
CDO_Mail_Object.TextBody = Email_Body
CDO_Mail_Object.AddAttachment TempFilePath & TempFileName & FileExtStr
CDO_Mail_Object.Send
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
MsgBox "Inviato"
End Sub
Occorre effettuare lo stesso tramite portale ZIMBRA, il cui "smtpserver" è: smtp.posta.kosservizi.com.
Premetto che oltre aver usato alternativamente le porte canoniche 25, 465 e 487;
-ho anche creato un loop da 1 a 1500 assegnando di volta in volta all'"smptserverport" il valore 1,2,...1500;
- ho disattivato il firewall
- ho utilizzato False e True per smtpusessl.
Se qualcuno ha qualche esperienza in campo....
Grazie e saluti
[Modificato da dodo47 26/01/2018 19:44]
Domenico
Win 10 - Excel 2016