lancio la macro e dopo un pò mi esce l'errore sopra indicato, poi cliccando su debug mi da di colore giallo la parte del codice racchiuso tra <b>... ho disattivato anche il firewall e non ho nessun antivirus..quello che non riesco a capire perchè a volte mi manda 10 email e a volte solo 5 ...se può essere più completo questo è il codice
Sub Unisci_gmail()
Dim objEmail, objConf, objFlds, vrtSelectedItem, selectedpath, MainDoc, msConfigURL
Dim messaggio, SoggettoEmail, PDFallegato, mailServer, mailusername, mailpassword, mailto, MailSubject, mailBody, SMTPport, DocName, EmailAddress As String
Dim i As Integer, fd As FileDialog
Const cdoSendUsingPort = 2 ' usa SMTP per l'invio
Const cdoBasicAuth = 1 ' autenticazione clear text
Const cdoTimeout = 60 ' Timeout SMTP in secondi
msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
'-------------configura qui i parametri di autenticazione e di invio--------------------
' indirizzo server SMTP
mailServer = "smtp.gmail.com"
' Porta SMTP
SMTPport = 465 '25 o 465
' Indorizzo email per il login
mailusername = "MIAEMAIL@gmail.com"
'password per il login
mailpassword = "PASS"
'inizia procedura per la selezione della cartella di destinazione
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
'Usa il metodo Show per mostrare la finestra di dialogo e restituire l'azione dell'utente
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
'vrtSelectedItem è una stringa che contiene l'indirizzo di ogni elemento selezionato.
'E' possibile usare qualsiasi funzione di I/O sui file utilizzando questo indirizzo.
selectedpath = vrtSelectedItem
Next vrtSelectedItem
Else
MsgBox ("Nessuna cartella è stata selezionata.")
Exit Sub
End If
End With
'-----------prepara il documento
Application.ScreenUpdating = False
MainDoc = ActiveDocument.Name
ChangeFileOpenDirectory selectedpath
'inizia la routine di creazione e invio per ogni singolo indirizzo email in tabella
For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
'instanzio l'oggetto item per l'email
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
'Utilizza alcuni campi del file sorgente per impostare il nome del file pdf
'IMPORTANTE: tali campi vanno personalizzati in base a quelli effettivamente
'presenti nella sorgente dati
'-----attenti alle righe seguenti: nel database DEVE essere presente il campo denominato "nome e cognome"----
'-----ed inoltre un campo denominato "email"-------
DocName = "Lettera_" & .DataFields("nome_e_cognome").Value & ".pdf"
EmailAddress = .DataFields("email").Value
' prendiamo il percorso completo del file da allegare
PDFallegato = selectedpath & "\" & DocName
'----attenti a questa riga: personalizzate a piacimento il messaggio, inteso come corpo del testo-------
messaggio = "Gentile " & .DataFields("nome_e_cognome").Value & " Le inviamo in allegato la comunicazione."
'----attenti a questa riga: qui mettete l'oggetto del vostro messaggio email-----
SoggettoEmail = "Invio comunicazione"
End With
.Execute Pause:=False
Application.ScreenUpdating = False
End With
ActiveDocument.ExportAsFixedFormat OutputFileName:=DocName, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveWindow.Close SaveChanges:=False
'---------------invia tramite GMAIL---------------
Set objEmail = CreateObject("CDO.Message")
Set objConf = objEmail.Configuration
Set objFlds = objConf.fields
'configura le impostazioni per l'invio
With objFlds
.Item(msConfigURL & "/sendusing") = cdoSendUsingPort
.Item(msConfigURL & "/smtpserver") = mailServer
.Item(msConfigURL & "/smtpserverport") = SMTPport
.Item(msConfigURL & "/smtpusessl") = True
.Item(msConfigURL & "/smtpconnectiontimeout") = cdoTimeout
.Item(msConfigURL & "/smtpauthenticate") = cdoBasicAuth
.Item(msConfigURL & "/sendusername") = mailusername
.Item(msConfigURL & "/sendpassword") = mailpassword
.Update
End With
'invia il messaggio e l'allegato
objEmail.To = EmailAddress
objEmail.From = mailusername
objEmail.Subject = SoggettoEmail
objEmail.TextBody = messaggio
objEmail.AddAttachment PDFallegato
objEmail.Send
' se ci sono altri indirizzi in coda riprendi la routine, altrimenti esci dal ciclo
Next i
'Fine spedizione, concludi procedure
Set objFlds = Nothing
Set objConf = Nothing
Set objEmail = Nothing
MsgBox "i " & i - 1 & "documenti sono stati inviati", vbOKOnly
End Sub