[VBA] Controllo mail

[Joe_01]

Salve a tutti, stavo realizzando questa semplice ( per voi) applicazione in VBA, ma mi sono bloccato in questi errori.

Vengo al problema, cercando qualche suggerimento da varie parti libri e internet, sono riuscito a mettere insieme questo codice che mi permette di memorizzare degli indirizzi e-mail in una tabella di Access 2010 e poi fare un invio singolo, ovvero ho creato una form con un pulsante che mi avvia le spedizioni.
Il problema è il seguente, se invio 3 o 4 e-mail va tutto bene, se cerco di inviarne per esempio 50 ad un certo punto esce un messaggio e il programma si ferma su (send) dicendo che occorre inserire un destinatario, un CC o un CCn........? (perchè se sta leggendo da un elenco di indirizzi)
Inoltre ho realizzato una query nella tabella dove ho messo l'istruzione nel campo mail "Is null" in modo che dove trova nella tabella il campo senza e-mail la lettura dei record posso continuare.
E questo è il primo problema.

Il secondo, se mi permettete di formularlo qui, è banale (per voi) vorrei semplicemente conteggiare le e-mail che invio, ho dichiarato una variabile "Tentativi" (tralasciamo il termine) volevo sapere come fare per calcolare quante e-mail vengono effettivamente compilate e spedite........
Ringraziandovi per la sempre validissima professionalità e soprattutto per la pazienza di cui siete dotati, spero in un vostro prezioso suggerimento.
Grazie a tutti


Allego il codice:

Const conPercorso = "\\server\Dati\Documenti\Uboldi\Varie\"
Const conAllegato = "\\server\Dati\Documenti\Uboldi\Varie\Curriculum_2 010.PDF"
Dim rstEmail As New ADODB.Recordset


Dim strNomeAllegato As String
Dim strDestinatario As String
Dim appOutlook As New Outlook.Application
Dim mail As Outlook.MailItem
Dim Tentativi As Integer
Tentativi = 0




Set appOutlook = CreateObject("outlook.application")

DoCmd.OpenQuery "qryEliminaNulliDaEmail"

rstEmail.Open "tbElencoAziende", CurrentProject.Connection, adOpenForwardOnly

'MsgBox rstEmail!Nome & rstEmail![E-Mail]


Do Until rstEmail.EOF

strDestinatario = rstEmail![mail]

If Not strDestinatario = "" Then


Set mail = appOutlook.CreateItemFromTemplate _
(conPercorso & "RicercaLavoro.oft")

With mail
.To = strDestinatario
' .Attachments.Add (conAllegato)
.Send
End With
Set mail = Nothing

End If
rstEmail.MoveNext

If mail.Send Then Tentativi ......................

Loop
MsgBox "Il messaggio è stato inviato correttamente"


End Sub

[MdE2005]

Originariamente inviato da Joe_01
Salve a tutti, stavo realizzando questa semplice ( per voi) applicazione in VBA, ma mi sono bloccato in questi errori.

Vengo al problema, cercando qualche suggerimento da varie parti libri e internet, sono riuscito a mettere insieme questo codice che mi permette di memorizzare degli indirizzi e-mail in una tabella di Access 2010 e poi fare un invio singolo, ovvero ho creato una form con un pulsante che mi avvia le spedizioni.
Il problema è il seguente, se invio 3 o 4 e-mail va tutto bene, se cerco di inviarne per esempio 50 ad un certo punto esce un messaggio e il programma si ferma su (send) dicendo che occorre inserire un destinatario, un CC o un CCn........? (perchè se sta leggendo da un elenco di indirizzi)
Inoltre ho realizzato una query nella tabella dove ho messo l'istruzione nel campo mail "Is null" in modo che dove trova nella tabella il campo senza e-mail la lettura dei record posso continuare.
E questo è il primo problema.

Che tipo di messaggio è?
Si ferma sempre nello stesso punto? Si ferma sempre dopo un numero preciso di invii?

Prova a mettere un MsgBox con 1° argomento il destinatario e 3° argomento (cioè titolo del MessageBox ) il record selezionato.

Originariamente inviato da Joe_01
Il secondo, se mi permettete di formularlo qui, è banale (per voi) vorrei semplicemente conteggiare le e-mail che invio, ho dichiarato una variabile "Tentativi" (tralasciamo il termine) volevo sapere come fare per calcolare quante e-mail vengono effettivamente compilate e spedite........
Ringraziandovi per la sempre validissima professionalità e soprattutto per la pazienza di cui siete dotati, spero in un vostro prezioso suggerimento.
Grazie a tutti


Allego il codice:

Const conPercorso = "\\server\Dati\Documenti\Uboldi\Varie\"
Const conAllegato = "\\server\Dati\Documenti\Uboldi\Varie\Curriculum_2 010.PDF"
Dim rstEmail As New ADODB.Recordset


Dim strNomeAllegato As String
Dim strDestinatario As String
Dim appOutlook As New Outlook.Application
Dim mail As Outlook.MailItem
Dim Tentativi As Integer
Tentativi = 0




Set appOutlook = CreateObject("outlook.application")

DoCmd.OpenQuery "qryEliminaNulliDaEmail"

rstEmail.Open "tbElencoAziende", CurrentProject.Connection, adOpenForwardOnly

'MsgBox rstEmail!Nome & rstEmail![E-Mail]


Do Until rstEmail.EOF

strDestinatario = rstEmail![mail]

If Not strDestinatario = "" Then


Set mail = appOutlook.CreateItemFromTemplate _
(conPercorso & "RicercaLavoro.oft")

With mail
.To = strDestinatario
' .Attachments.Add (conAllegato)
.Send
End With
Set mail = Nothing

End If
rstEmail.MoveNext

If mail.Send Then Tentativi ......................

Loop
MsgBox "Il messaggio è stato inviato correttamente"


End Sub

Non mi ricordo se esiste un metodo per verificare se la mail è stata spedita, in tal caso non è possibile sapere se realmente l'invio è andato a buon fine; per incrementare il contatore basta dichiarare la variabile all'esterno del ciclo Do Until (come hai fatto) e poi aumentare tale valore di +1 alla fine del ciclo:

Dim contatore as Integer
Do Until .......
'esegui tutte le tue operazioni
contatore = contatore + 1
Loop

Ciao

[Joe_01]

Ti ringrazio die suggerimenti.
Fra informazioni da una parte e letture dall'altra sono riuscito ad ottenere un applicativo relativamente funzionante.
L'unica cosa che non riesco ad attivare è il conteggio delle e-mail spedite, mi da sempre zero.
Allego il codice e attendo un prezioso aiuto.
Grazie a tutti.

Private Sub Comando17_Click()


Const conPercorso = "\\server\Dati\Documenti\Uboldi\Varie\"
Const conAllegato = "\\server\Dati\Documenti\Uboldi\Varie\Curriculum_2 010.PDF"
Dim rstEmail As New ADODB.Recordset



On Error GoTo Err_Mail

Dim strNomeAllegato As String
Dim strDestinatario As String
Dim appOutlook As New Outlook.Application
Dim mail As Outlook.MailItem
Dim TOTMAILS As String
Dim TOTSENT As Integer


Set appOutlook = CreateObject("outlook.application")

DoCmd.OpenQuery "qryEliminaNulliDaEmail"

rstEmail.Open "tbElencoAziende", CurrentProject.Connection, adOpenForwardOnly

'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

DoEvents
If .Sent Then TOTSENT = TOTSENT + 1
Here:

End With
'Set mail = Nothing
End If
rstEmail.MoveNext

Loop

Exit Sub





Err_Mail:
' quale Err.Number viene generato in caso non venga inviata e fare il Resume in [Here:]


MsgBox "Invio avvenuto con successo"
MsgBox (TOTSENT)



End Sub

[MdE2005]

C'è un primo errore e riguarda il tipo della variabile TOTMAILS: non deve essere di tipo String ma Integer, visto che si tratta di un dato numerico.
La variabile TOTSENT è dichiarata correttamente, però devi inizializzarla, cioè darle un valore: in questo caso ponila uguale a 0 prima del tuo ciclo.


Ciao

[Joe_01]

Avevo già dichiarato TOTMAIL (integer) ma mi da errore sull'istruzione:

TOTMAILS = rstEmail.RecordCount evidenzia il RecordCount (Tipo non corrispondente)

[MdE2005]

Quindi l'errore si presenta anche avendo cambiato la dichiarazione della variabile, da String ad Integer?

Se fosse così, prova a guardare la documentazione per vedere che tipo di dato restituisce il metodo RecordCount, ma sembra strano che non sia Integer..


Fammi sapere

[gibra]

La proprietà RecordCount è di tipo Long.

Se non vado errato, le applicazioni OFFICE internamente usano DAO (ma non sappiamo quale versione stai usando quindi potrebbe essere diverso).
Tu, invece, stai usando un recordset di ADO che è soggetto ad altre caratteristiche che potrebbero non essere compatibili con una connessione DAO.

Se infatti la CurrentProject.Connection è una connessione DAO, allora sarebbe il caso di usare un recordset DAO, non ADO.
In questo caso dovrai eseguire MoveLast e MoveFirst per ottenere il numero corretto di RecordCount, ma per farlo non devi aprire il recordset in modalità adOpenForwardOnly.


Se usi un recordset ADO, ti consiglio di verificare con il metodo Supports del recordset stesso che venga restituito True per la proprietà adBookmark o adApproxPosition, solo in qul caso sei sicuro che la proprietà RecordCount è supportata.

Tra l'altro, per un recordset ADO, il valore di RecordCount è strettamente correlato al tipo di cursore (CursorLocation) utilizzato:
Un cursore lato server (adUseServer) non supporta tale proprietà e restituirà sempre -1, quindi è inservibile.
Per un recordset ADO il valore corretto è immediatamente accessibile solo con cursori lato client (adUseClient) quindi senza dover essere costretti ad eseguire MoveLast e MoveFirst.

P.S.
Un paio di consigli perchè stai facendo un po' di confusione:

1.
non devi dichiarare
Dim rstEmail As New ADODB.Recordset
ma:
Dim rstEmail As ADODB.Recordset
Set rstEmail = New ADODB.Recordset

2.
Dato che hai dichiarato
Dim appOutlook As New Outlook.Application
non deve istanziare l'oggetto Outlook usando CreateObject(), ma semplicemente

Dim appOutlook As Outlook.Application
Set appOutlook = New Outlook.Application

[Joe_01]

Ti ringrazio GIBRA per le informazioni che mi ha suggerito, ma purtroppo credo di aver fatto solo un gran pasticcio.
La suite di Office che uso è la 2010, io ho cercato fra informazioni in internet e dei libri che ho ha casa di mettere insieme il codice che hai potuto valutare, ma con dei pessimi risultati.
Credo che tu abbia ragione riguardo ADO - DAO.
Scusa se mi permetto di chiederti tanto, ma potresti suggerirmi dove fare le dovute correzzioni, non riesco a venirne a capo, in fondo devo inviare delle e-mail e conteggiarle, ti sarei veramente grato se puoi aiutarmi a risolvere la cosa, sono completamente in palla.
Aspetto una tua preziosa risposta, grazie ancora.

Allego il codice con le ultime correzioni:





Private Sub Comando17_Click()


Const conPercorso = "\\server\Dati\Documenti\Uboldi\Varie\"
Const conAllegato = "\\server\Dati\Documenti\Uboldi\Varie\Curriculum_2 010.PDF"
'Dim rstEmail As New ADODB.Recordset
'Dim rstEmail As ADODB.Recordset
'Set rstEmail = New ADODB.Recordset
Dim rstEmail As DAO.Recordset
Set rstEmail = New DAO.??????????????????




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 Long
Dim TOTSENT As Integer


'Set appOutlook = CreateObject("outlook.application")
Set appOutlook = New Outlook.Application


DoCmd.OpenQuery "qryEliminaNulliDaEmail"

rstEmail.Open "tbElencoAziende", CurrentProject.Connection, adOpenForwardOnly

'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 Sub


' 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 Sub

[gibra]

Purtroppo non mastico né l'ambiente MSAccess né DAO, quindi non credo di essere la persona più indicata. Comunque quando sei in ambiente VBA hai a disposizione la guida a Microsoft Visual Basic for Applications, di sicuro trovi tutte le informazioni.

Premetto che, dato che tu usi Office 2010, non ho la minima idea se gli oggetti utilizzati da MSAccess siano gli stessi delle versioni precedenti (mi auguro di sì!).


Per quel poco che posso dirti:

1) Set rstEmail = New DAO.??????????????????
usa
Set rstEmail = New DAO.Recordset

2)in DAO il recordset si apre con il metodo
OpenRecordset indicando il tipo: dbOpenDynaset (e NON adOpenForwardOnly come stai facendo tu)

3) Dopo aver aperto rstEmail esegui queste due istruzioni
rstEmail.MoveLast
rstEmail.MoveFirst
così otterrai il numero dei record in
rstEmail.RecordCount

A quel punto esegui il tuo codice.

Eventualmente, se hai problemi, torna qui, mostra il codice [stavolta formattato come CODICE usando il pulsantino CODE ] come indicato nel Regolamento, e vediamo il da farsi

[Joe_01]

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

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