Redemption and Outllook Problem

Greetings,

I am trying to loop through a query and send an email for each record in the results. I have all of that working fine - until I go to send the email. I am working in Access and Outlook XP. I have redemption installed as well - which seems to be working.

I had this working before and now can't quite get it to work.

After sending one message successfully I get and error on the objSafe.Send line.

It is a run-time error with the message "Method 'Update' not supported by automation object"

I have included a stripped down sample of the code I am attempting to use (a once had working)

Any insight would be great!!

CODE:

Function TestSend()

Set objSafe = CreateObject("Redemption.SafeMailItem")
Set objApp = CreateObject("Outlook.Application")
Set objItem = objApp.CreateItem(i)

For i = 1 To 10

objItem.To = "user@domain.com"
objItem.Subject = "Subject"
objItem.Body = "text"
objSafe.Item = objItem
objSafe.Send
Sleep 2000

Next i

End Function

Would U close the objSafe object after send the first mail??U can check it..

It doesn't look like you've posted the code that is giving the actual error.

Figured it out.....

A couple of changes that seemed to correct the code:

Put some of the "Set" statements within the loop

and

Making sure all the Items of SafeMail are not exactly the same through the iterations of the loop (at least not one right after another). Initially when testing I was looping through a repeating list of two addresses (the next address was always different).

I changed the list to all one address at one point and that is when it stop working (I however had the 'On Error resume Next' statement -which made me initially miss the error). Not sure why having all the same items creates an error ??

Here is the code that finally worked for me (I do need to clean it up - any ideas or reccomendations would be appreciated - I am rather new to this!)


Code Begin:

Option Compare Database

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Function SendSafeMail()

Dim objApp As Outlook.Application
Dim objSafe As Redemption.SafeMailItem

' Create Objects

Set db = CurrentDb
Set rs = db.OpenRecordset("tblTest")

On Error Resume Next

'Get MS Word if it's running
Set objMSWord = GetObject(, "Word.Application")
objMSWord.Visible = True
If Err <> 0 Then
'MS Word wasn't running, start it from code
Set objMSWord = CreateObject("Word.Application")
bStarted = True
End If

Set objDoc = objMSWord.Documents.Open("C:\Documents and Settings\user\Desktop\express.doc", ReadOnly:=True)

' Returns Message Box if not Records returned.
If rs.RecordCount = 0 Then
MsgBox ("No Records To Mail")
End If

' Displays warning message with number of emails to be sent
rs.MoveLast
nB = vbExclamation + vbYesNo
mText = "You are about to send " & rs.RecordCount & " emails!! Do you want to continue?"
Msg = MsgBox(mText, vbYesNo + vbExclamation, "SENDING EMAIL")

If Msg = vbYes Then
rs.MoveFirst

With rs

Do Until .EOF

Set objSafe = CreateObject("Redemption.SafeMailItem")
Set objApp = CreateObject("Outlook.Application")
Set objItem = objApp.CreateItem(0)
Set objBar = objApp.ActiveExplorer.CommandBars("Standard")
Set objCmd = objBar.Controls("Send/Receive")
Set attchmnt = objItem.Attachments
attchmnt.Add "C:\Documents and Settings\user\Desktop\Express.doc"

objItem.To = ![EMAIL_ADDRESS]
objItem.Subject = "Subject Line"
objItem.Body = objDoc.Content
objItem.SentOnBehalfOfName = "SomeUser"
objSafe.Item = objItem
objSafe.Send
objCmd.Execute
Sleep 2000
.MoveNext


Loop

End With
End If

If bStarted Then
objDoc.Close False
objMSWord.Quit False
Set objMSWord = Nothing
End If

Set objItem = Nothing
Set objSafe = Nothing

End Function

END CODE

I created this because I got an unhappy response from our System's Admin for nailing our mail server with several thousand emails at once. This script automates the process vary nicely with a slight pause before sending the next message.



Thanks for the input!

Cheers!

PS some of this code is piecemealed by searching the web and copy/paste - so I do not take claim to all of it.

I have read whole your code.I think u should modify these statement in the loop as it:
Set objSafe = CreateObject("Redemption.SafeMailItem")
Set objApp = CreateObject("Outlook.Application")
Set objItem = objApp.CreateItem(0)
Set objBar = objApp.ActiveExplorer.CommandBars("Standard")
Set objCmd = objBar.Controls("Send/Receive")

Do Until .EOF
Set attchmnt = objItem.Attachments
attchmnt.Add "C:\Documents and Settings\user\Desktop\Express.doc"
objItem.To = ![EMAIL_ADDRESS]
objItem.Subject = "Subject Line"
objItem.Body = objDoc.Content
objItem.SentOnBehalfOfName = "SomeUser"
objSafe.Item = objItem
objSafe.Send
objCmd.Execute
set attchmnt=nothing
Sleep 2000
.MoveNext

Loop

Set objCmd=Nothing
Set objBar=Nothing
Set objItem = Nothing
Set objSafe = Nothing
Set objApp=Nothing
...