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