[VBA] Invio di email da Access utilizzando Outlook

[fanigliuloa]

salve a tutti
vorrei spedire delle email daò mio gestionale access utlizzando outlook.
Per far cio' uso il seguente script vb che richiamo al click di un pulsante in una amschera access.

strSql = "SELECT EMail FROM Iscritti WHERE (EMail <> ' ')"
Set Lrs = db.OpenRecordset(strSql)
Do While Not Lrs.EOF
Outlook = Outlook + Lrs("EMail") + ";"
Lrs.MoveNext
Loop

Dim rng
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = Outlook
.Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

il problema è che avendo un account gmail nno posso inviare mail a più di 100 destinatari per volta. Qundi dovrei dividere le mail con 100 destinatari per volta. come potrei fare ?

Grazie per l'aiuto

[oregon]

All'interno del ciclo do while gestisci un contatore. Se arriva a 100, esegui l'invio, azzera il contatore e la stringa degli indirizzi e fai nuovamente il giro ...

[fanigliuloa]

grazie, ho fatto coem mi hai suggerito, il problema è che se ho ad esempio 260 indirizzi mi manda solo i primi 200

strSql = "SELECT EMail FROM Iscritti WHERE (EMail <> ' ')"
End If


Set Lrs = db.OpenRecordset(strSql)
Do While Not Lrs.EOF
contatore = contatore + 1

Outlook = Outlook + Lrs("EMail") + ";"
If (contatore = 100) Then
contatore = 0

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = Outlook
.Display
End With
On Error GoTo 0
Outlook = ""
End If


Lrs.MoveNext
Loop


Set OutMail = Nothing
Set OutApp = Nothing

[oregon]

If (contatore = 100) Or Lrs.EOF Then

[fanigliuloa]

grazie adesso funziona

ho messo la condizione EOF fuori dal while perchè all'interno del while non ci passava mai

strSql = "SELECT EMail FROM Iscritti WHERE (EMail <> ' ')"
End If


Set Lrs = db.OpenRecordset(strSql)
Do While Not Lrs.EOF
contatore = contatore + 1
Outlook = Outlook + Lrs("EMail") + ";"
If ((contatore = 100)) Then
contatore = 0

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = Outlook
.Display
End With
On Error GoTo 0
Outlook = ""
End If
Lrs.MoveNext
Loop


If (Lrs.EOF) Then


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = Outlook
.Display
End With
On Error GoTo 0
End If


A presto, ciao!