Invio email tramite excel CDO

dodo47
Posts: 1
Joined: Thu Jan 25, 2018 4:51 pm

Invio email tramite excel CDO

Postby dodo47 » Thu Jan 25, 2018 5:51 pm

Ciao a tutti,
sono nuovo del forum e non so se questo è il posto giusto dove postare il mio problema. Qualora non fosse cos' prego l'Amministratore di spostare nel sito corretto.

Il mio problema:
devo inviare tramite excel (uso il metodo CDO) delle email da un indirizzo Zimbra ad un altro indirizzo Zimbra, allegando il foglio corrente.

Per farlo uso questa macro che comunque mi restituisce un errore di run-time: "Il trasporto non è riuscito a connettersi al server"

Code: Select all

Sub SendEmail()
   
    Dim CDO_Mail_Object As Object
    Dim CDO_Config As Object
    Dim SMTP_Config As Variant
    Dim Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Subject, 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

   
    Email_Subject = "Esempio"
    Email_Send_From = "Pippo@anniazzurri.it"
    Email_Send_To = "Pluto@anniazzurri.it" '<<<<<<destinatario VARIARE>>>>>>>
    Email_Body = "Cari saluti"
   
    Set sh = Worksheets("Sheet1")
    sh.Copy
    Set wb = ActiveWorkbook
   
    TempFileName = "Allegato"
    With wb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    .Close savechanges:=False
    End With
   
   
    Set CDO_Mail_Object = CreateObject("CDO.Message")
    On Error GoTo debugs
    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.posta.kosservizi.com" '<<<<<<VARIARE>>>>>>>
        .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465 '<<<<<<NON SO SE VA BENE PER ZIMBRA>>>>>>>
        .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") = "Pippo@anniazzurri.it" '<<<<<<VARIARE (Chi Manda)>>>>>>>
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password" '<<<<<<VARIARE>>>>>>> (psw)
        .Update
    End With
   
    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

End Sub


Ho fato diversi tentativi, introducendo un loop for i=1 to 1500 per variare l'assegnazione di smptserverport, una volta ponendo l'smtpusessl = True e una volta = False senza nessun risultato.

Grazie per la vostra attenzione
Domenico


Return to “Italian”

Who is online

Users browsing this forum: No registered users and 0 guests