Questo è l'impasto che sono riuscito a realizzare, purtroppo l'istruzione (Set rstEmail = DAO.Recordset) ho dovuto commerntarlo perchè non riconosce il "Recordset" anche perchè con l'intellisense mi da altri termini.
Poi anche l'apertura del DB non riesco a crearla.....
Aspetto il vostro aiuto.
Grazie
codice:
Private Sub Comando17_Click()
Const conPercorso = "\\server\Dati\Documenti\Uboldi\Varie\"
Const conAllegato = "\\server\Dati\Documenti\Uboldi\Varie\Curriculum_2010.PDF"
'Dim rstEmail As New ADODB.Recordset
'Dim rstEmail As ADODB.Recordset
'Set rstEmail = New ADODB.Recordset
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Set dbs = CurrentDb
Set tdf = dbs.CreateTableDef
tdf.Name = "tbElencoAziende"
Dim rstEmail As DAO.Recordset
'Set rstEmail = DAO.Recordset
On Error GoTo Err_Mail
Dim strNomeAllegato As String
Dim strDestinatario As String
'Dim appOutlook As New Outlook.Application
Dim appOutlook As Outlook.Application
Dim mail As Outlook.MailItem
Dim TOTMAILS As String
Dim TOTSENT As Integer
'Set appOutlook = CreateObject("outlook.application")
Set appOutlook = New Outlook.Application
DoCmd.OpenQuery "qryEliminaNulliDaEmail"
'rstEmail.Open "tbElencoAziende", CurrentProject.Connection, adOpenForwardOnly
'Set rstEmail = tbElencoAziende.OpenRecordset(dbOpenDynaset)
rstEmail.MoveLast
rstEmail.MoveFirst
'rstEmail.Open "SELECT * FROM tbElencoAziende WHERE LEN(mail)>0 Order By mail", CurrentProject.Connection, adOpenForwardOnly
TOTMAILS = rstEmail.RecordCount
'MsgBox rstEmail!Nome & rstEmail![E-Mail]
Do Until rstEmail.EOF
strDestinatario = rstEmail![mail]
If Not strDestinatario = "" Then
'Set mail = appOutlook.CreateItemFromTemplate(conPercorso & "RicercaLavoro.oft")
Set mail = appOutlook.CreateItemFromTemplate(conPercorso & "RicercaLavoro.oft")
With mail
.To = strDestinatario
' .Attachments.Add (contsAllegato)
.Send
TOTSENT = 0
DoEvents
If .Sent Then TOTSENT = TOTSENT + 1
Here:
End With
'Set mail = Nothing
End If
rstEmail.MoveNext
Loop
'Exit Function
' Quì controlla che il Totale coincida con l'inviato....
Err_Mail:
' quì devi trovare quale Err.Number viene generato in caso non venga inviata e fare il Resume in [Here:]
MsgBox "Invio avvenuto con successo"
MsgBox (TOTSENT)
'End Function
End Sub