Ciao,
vi disturbo per questo problema, ho reperito e riadattato del codice per l'invio con un pulsante di una email con gli allegati pdf (al momento comunque non vi disturbo per l'allegato che non ho gestito)
non riesco ad inviare email e l'errore che ricevo è 80040220 il valore di configurazione sendusing non è valido, cosa sbaglio?
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim ConteggioRecord As Long
Dim var_allegato As String
Dim var_bambino As String
Dim var_genitori As String
Dim var_email As String
Dim olApp As Object
Dim objMail As Object
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
'setta il recordset
Dim strsql_report_invia As String
strsql_report_invia = ""
strsql_report_invia = strsql_report_invia & "SELECT q_Invio_riepiloghi.Id_bambino, q_Invio_riepiloghi.Id_genitore, q_Invio_riepiloghi.Path, q_Invio_riepiloghi.Bambino, q_Invio_riepiloghi.Genitore_fat, "
strsql_report_invia = strsql_report_invia & "q_Invio_riepiloghi.Gen1, q_Invio_riepiloghi.Gen2, q_Invio_riepiloghi.email_bambino "
strsql_report_invia = strsql_report_invia & "FROM q_Invio_riepiloghi; "
' Apre la query
Set db = CurrentDb
Set rst = db.OpenRecordset(strsql_report_invia)
rst.MoveFirst
' Conteggio record presenti nella query
ConteggioRecord = rst.RecordCount
' Se nessun record crea messaggio apposito
If ConteggioRecord = 0 Then
MsgBox "NESSUN REPORT DA INVIARE", vbInformation
' Altrimenti inizia loop
Else
rst.MoveLast
rst.MoveFirst
Do Until rst.EOF
ConteggioRecord = ConteggioRecord + 1
' Imposta indirizzo destinatario
var_email = rst![email_bambino]
' Imposta COGNOME NOME BAMBINO
var_bambino = UCase(rst![Bambino])
' Imposta COGNOME NOME GENITORI
var_genitori = UCase(rst![Gen1]) & " " & UCase(rst![Gen2])
' Imposta l'allegato
var_allegato = rst![Path]
schema = "https://webmail.aruba.it/index.html?_v_=v4r2b49.20161003_1200"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.yyyyyyyyyy.it"
Flds.Item(schema & "smtpserverport") = 25
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = "info@yyyyyyyyyy.it"
Flds.Item(schema & "sendpassword") = "ssssssss"
Flds.Item(schema & "smtpusessl") = 1
Flds.Update
' Compila il messaggio email
With iMsg
'.To = var_email
.To = "info@xxxxxxxxx.com"
.From = "info@yyyyyyyyyy.it"
.Subject = "invio retta da pagare"
.HTMLBody = "Gentili " & var_genitori & ",<BR> con la presente inviamo riepilogo retta riferita a<BR> " & var_bambino & "<BR> cordiali saluti: <BR>" & "<BR> ASilo Nido <BR>"
.Sender = "smtp.aruba.it"
.Organization = "aruba"
Set .Configuration = iConf
.Send
End With
rst.MoveNext
Loop
' Messaggio di conferma
ConteggioRecord = ConteggioRecord - 1
MsgBox "Inviati correttamente " & ConteggioRecord & " report alle famiglie."
End If
'Chiude query
rst.Close
Set rst = Nothing