- Katılım
- 16 Ekim 2006
- Mesajlar
- 135
- Excel Vers. ve Dili
- Microsoft
Toplu mail gönderme en fazla 100 kişiye göndermiş
Arkadaşlar toplu mail göndermek için forum dan aldığım aşagıdaki kodları kullanıyorum ancak Listemde 300 kişi olmasına ragmen sadece 100 kişiye mail göndermiş bu neden olur
Private Sub cmdEmail_Click()
Dim rs As New ADODB.Recordset
Dim str As String
Dim Y, Z As Integer
Dim K, Q As Double
rs.Open "emails1", CurrentProject.Connection, adOpenKeyset, adLockReadOnly
Z = rs.RecordCount / 100 Mod 100
If rs.EOF = True Then
MsgBox "Herhangi bir e-mail adresi kayıtlı değil."
Else
rs.MoveFirst
K = 0
Q = 0
Do While Not rs.EOF
If IsNull(rs(0)) Then
rs.MoveNext
Else
str = str & rs(0) & ", "
rs.MoveNext
K = K + 1
If K Mod 100 = 0 And Q < Z Then
GoSub Mail
str = ""
Q = Q + 1
Else
If Q = Z And rs.EOF Then
GoSub Mail
End If
End If
End If
Loop
End If
rs.Close
Set rs = Nothing
Exit Sub
Mail:
Dim stDocName As String
stDocName = "Empty_Report"
' DoCmd.SendObject acReport, stDocName, acFormatSNP, strBCC, , , strSubject, strBody
DoCmd.SendObject acSendNoObject, stDocName, , str, , , "2. el Tezgahlarımız", , True
Return
End Sub
Arkadaşlar toplu mail göndermek için forum dan aldığım aşagıdaki kodları kullanıyorum ancak Listemde 300 kişi olmasına ragmen sadece 100 kişiye mail göndermiş bu neden olur
Private Sub cmdEmail_Click()
Dim rs As New ADODB.Recordset
Dim str As String
Dim Y, Z As Integer
Dim K, Q As Double
rs.Open "emails1", CurrentProject.Connection, adOpenKeyset, adLockReadOnly
Z = rs.RecordCount / 100 Mod 100
If rs.EOF = True Then
MsgBox "Herhangi bir e-mail adresi kayıtlı değil."
Else
rs.MoveFirst
K = 0
Q = 0
Do While Not rs.EOF
If IsNull(rs(0)) Then
rs.MoveNext
Else
str = str & rs(0) & ", "
rs.MoveNext
K = K + 1
If K Mod 100 = 0 And Q < Z Then
GoSub Mail
str = ""
Q = Q + 1
Else
If Q = Z And rs.EOF Then
GoSub Mail
End If
End If
End If
Loop
End If
rs.Close
Set rs = Nothing
Exit Sub
Mail:
Dim stDocName As String
stDocName = "Empty_Report"
' DoCmd.SendObject acReport, stDocName, acFormatSNP, strBCC, , , strSubject, strBody
DoCmd.SendObject acSendNoObject, stDocName, , str, , , "2. el Tezgahlarımız", , True
Return
End Sub
Son düzenleme: