L
Ludo Soete
Hi all,
Question1:
I do have a problem with the code i found somewhere to send mail using
MAPI.
Everything works fine BUT the mails aren't send, they hang in the
'Send Messages' folder.
Note: I create for every member of our club a separate mail (actually
32 members = 32 separate mails). This works fine, but they aren't
send!
I have Outlook Express on my PC, running Windows98 SE
Question2:
Is it possible, using MAPI control (VBA), to delete the send mails
from my 'Send Mails' folder after the mails are send? If so, how to do
so?
here's the code i use for creating the mails:
Sub Send()
Dim ListEnd As Boolean
On Error GoTo errorhandler
ListEnd = False
frmBulkMail.MAPIMessages1.MsgIndex = -1
frmBulkMail.MAPISession1.SignOn
Select Case MailToType
Case 1 '
Sheets("members").Activate
Range("J2").Select
Case 2 '
Sheets("board").Activate
Range("D2").Select
Case 3 '
Sheets("members").Activate
Range("J2").Select
End Select
Do
Select Case MailToType
Case 1 '
If Trim(ActiveCell.Value) <> "" Then
strMailTo = Trim(ActiveCell.Value)
End If
selection.Offset(1, 0).Select 'select next row
Case 2 '
If Trim(ActiveCell.Value) <> "" Then
strMailTo = Trim(ActiveCell.Value)
End If
selection.Offset(1, 0).Select 'select next row
Case 3 '
If selection.Offset(0, 1).Value <> False Then
strMailTo = Trim(ActiveCell.Value)
End If
selection.Offset(1, 0).Select 'select next row
End Select
If strMailTo <> "" Then
frmBulkMail.MAPIMessages1.SessionID =
frmBulkMail.MAPISession1.SessionID
If blContactMe = True Then
frmBulkMail.MAPIMessages1.RecipAddress =
"(e-mail address removed)"
Else
frmBulkMail.MAPIMessages1.RecipAddress = strMailTo
End If
If Trim(frmBulkMail.txtSubject) = "" Then
frmBulkMail.MAPIMessages1.MsgSubject = "Dit is een
automatische mail verstuurd door BeLUG Admin."
Else
frmBulkMail.MAPIMessages1.MsgSubject = "BeLUG : " &
frmBulkMail.txtSubject
End If
frmBulkMail.MAPIMessages1.MsgNoteText = frmBulkMail.tbMessage
frmBulkMail.MAPIMessages1.Send
' DoEvents
End If
Select Case MailToType
Case 1
If Trim(selection.Offset(0, -9)) = "" Then
ListEnd = True
End If
Case 2
If ActiveCell.Address = "$D$7" Then
ListEnd = True
End If
Case 3
If selection.Offset(0, 1).Value = False Then
ListEnd = True
End If
End Select
strMailTo = ""
Loop Until ListEnd = True
frmBulkMail.MAPISession1.DownLoadMail = True
frmBulkMail.MAPISession1.SignOff
Exit Sub
errorhandler:
Select Case Err.Number
Case 32010
MsgBox "TooManyRecipients", vbCritical + vbOKOnly
frmBulkMail.MAPISession1.SignOff
Case 32025
MsgBox "InvalidRecips", vbCritical + vbOKOnly
frmBulkMail.MAPISession1.SignOff
Case Else
MsgBox "Fatal Mail Error ", vbCritical + vbOKOnly
frmBulkMail.MAPISession1.SignOff
End Select
End Sub
Thanks in advance for any help.
Regards,
Ludo Soete
Question1:
I do have a problem with the code i found somewhere to send mail using
MAPI.
Everything works fine BUT the mails aren't send, they hang in the
'Send Messages' folder.
Note: I create for every member of our club a separate mail (actually
32 members = 32 separate mails). This works fine, but they aren't
send!
I have Outlook Express on my PC, running Windows98 SE
Question2:
Is it possible, using MAPI control (VBA), to delete the send mails
from my 'Send Mails' folder after the mails are send? If so, how to do
so?
here's the code i use for creating the mails:
Sub Send()
Dim ListEnd As Boolean
On Error GoTo errorhandler
ListEnd = False
frmBulkMail.MAPIMessages1.MsgIndex = -1
frmBulkMail.MAPISession1.SignOn
Select Case MailToType
Case 1 '
Sheets("members").Activate
Range("J2").Select
Case 2 '
Sheets("board").Activate
Range("D2").Select
Case 3 '
Sheets("members").Activate
Range("J2").Select
End Select
Do
Select Case MailToType
Case 1 '
If Trim(ActiveCell.Value) <> "" Then
strMailTo = Trim(ActiveCell.Value)
End If
selection.Offset(1, 0).Select 'select next row
Case 2 '
If Trim(ActiveCell.Value) <> "" Then
strMailTo = Trim(ActiveCell.Value)
End If
selection.Offset(1, 0).Select 'select next row
Case 3 '
If selection.Offset(0, 1).Value <> False Then
strMailTo = Trim(ActiveCell.Value)
End If
selection.Offset(1, 0).Select 'select next row
End Select
If strMailTo <> "" Then
frmBulkMail.MAPIMessages1.SessionID =
frmBulkMail.MAPISession1.SessionID
If blContactMe = True Then
frmBulkMail.MAPIMessages1.RecipAddress =
"(e-mail address removed)"
Else
frmBulkMail.MAPIMessages1.RecipAddress = strMailTo
End If
If Trim(frmBulkMail.txtSubject) = "" Then
frmBulkMail.MAPIMessages1.MsgSubject = "Dit is een
automatische mail verstuurd door BeLUG Admin."
Else
frmBulkMail.MAPIMessages1.MsgSubject = "BeLUG : " &
frmBulkMail.txtSubject
End If
frmBulkMail.MAPIMessages1.MsgNoteText = frmBulkMail.tbMessage
frmBulkMail.MAPIMessages1.Send
' DoEvents
End If
Select Case MailToType
Case 1
If Trim(selection.Offset(0, -9)) = "" Then
ListEnd = True
End If
Case 2
If ActiveCell.Address = "$D$7" Then
ListEnd = True
End If
Case 3
If selection.Offset(0, 1).Value = False Then
ListEnd = True
End If
End Select
strMailTo = ""
Loop Until ListEnd = True
frmBulkMail.MAPISession1.DownLoadMail = True
frmBulkMail.MAPISession1.SignOff
Exit Sub
errorhandler:
Select Case Err.Number
Case 32010
MsgBox "TooManyRecipients", vbCritical + vbOKOnly
frmBulkMail.MAPISession1.SignOff
Case 32025
MsgBox "InvalidRecips", vbCritical + vbOKOnly
frmBulkMail.MAPISession1.SignOff
Case Else
MsgBox "Fatal Mail Error ", vbCritical + vbOKOnly
frmBulkMail.MAPISession1.SignOff
End Select
End Sub
Thanks in advance for any help.
Regards,
Ludo Soete