Salve a tutti, ho il seguente problema. Queste due macro inizialmente funzionavano con l'ausilio di outlook; in seguito non potendo più utilizzarlo le ho modificate per farle funzionare senza. L'invio delle mail ora continua a farlo regolarmente, però da quando ho apportato la modifica non mi invia più gli allegati. Sinceramente non riesco a capirne la motivazione, e spero che qualcuno più esperto di me possa aiutarmi. Gli indirizzi mail li prende dalla colonna A mentre gli allegati dalla colonna B. Grazie.
- Codice: Seleziona tutto
Sub Inviamail(mail As String, file As String, ccmail As String, i As Integer)
Dim iConf As Object
Dim Flds As Variant
Dim OutMail As Object
Dim bodymail As String
Dim c As Integer
Set OutMail = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
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") = "xxxxxxxx@gmail.com" ' indirizzo accesso
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxx" 'password accesso
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
On Error Resume Next
With OutMail
Set .Configuration = iConf
.From = "xxxxxxxx@gmail.com"
.To = mail
.CC = Trim(ccmail)
.BCC = Cells(11, 6)
.Subject = Cells(12, 6)
.BodyFormat = olFormatHTML
bodymail = "<html><head></head><body>"
For c = 1 To 9
bodymail = bodymail + Cells(c + 12, 6) + "<br />"
Next c
bodymail = bodymail + "<br /><br /><br />" + "<b>" + Cells(21, 6) + "</b></html></body>"
.HTMLbody = bodymail
.Attachments.Add file
.send
End With
On Error GoTo errore
Cells(i, 4) = "INVIATA"
Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
errore:
Cells(i, 3) = "ERRORE"
End Sub
- Codice: Seleziona tutto
Sub listamail()
Dim i As Integer
Dim mail As String
Dim ccmail As String
Dim file As String
Dim percorso As String
Range("D2:D21").ClearContents
percorso = Cells(8, 5)
If Right$(percorso, 1) <> "\" Then percorso = percorso & "\"
i = 2
While Trim(Cells(i, 1)) <> ""
mail = Cells(i, 1)
file = percorso + Cells(i, 2)
ccmail = Cells(i, 3)
Call Inviamail(mail, file, ccmail, i)
i = i + 1
Wend
End Sub