S
staverts
Hello all, I am using MS Access 2000, I Found some code to look through a
tables recordset, and send an email to all users in that feild. The Code
errors on this line:
Set MyRS = MyDB.OpenRecordset _
("tblSMSCustomerStorage")
I alredy added DAO 3.6, but it still errors. This was orginally Access 97
Code, Can someone please help me
Here is the full Code:
Private Sub Command10_Click()
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim TheAddress As String
Set MyDB = CurrentDb()
Set MyRS = MyDB.OpenRecordset _
("tblSMSCustomerStorage")
MyRS.MoveFirst
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Do Until MyRS.EOF
' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
TheAddress = MyRS![kuemail]
With objOutlookMsg
' Add the To recipient(s) to the e-mail message.
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the e-mail message.
If (IsNull(Forms!frmMail!CCAddress)) Then
Else
Set objOutlookRecip = .Recipients.Add(Forms!frmMail!CCAddress)
objOutlookRecip.Type = olCC
End If
' Set the Subject, Body, and Importance of the e-mail message.
.Subject = Forms!frmMail!Subject
.Body = Forms!frmMail!MainText
.Importance = olImportanceHigh 'High importance
'Add attachments to the e-mail message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
MyRS.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
Please Help!
Thanks in Advance!
tables recordset, and send an email to all users in that feild. The Code
errors on this line:
Set MyRS = MyDB.OpenRecordset _
("tblSMSCustomerStorage")
I alredy added DAO 3.6, but it still errors. This was orginally Access 97
Code, Can someone please help me
Here is the full Code:
Private Sub Command10_Click()
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim TheAddress As String
Set MyDB = CurrentDb()
Set MyRS = MyDB.OpenRecordset _
("tblSMSCustomerStorage")
MyRS.MoveFirst
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Do Until MyRS.EOF
' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
TheAddress = MyRS![kuemail]
With objOutlookMsg
' Add the To recipient(s) to the e-mail message.
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the e-mail message.
If (IsNull(Forms!frmMail!CCAddress)) Then
Else
Set objOutlookRecip = .Recipients.Add(Forms!frmMail!CCAddress)
objOutlookRecip.Type = olCC
End If
' Set the Subject, Body, and Importance of the e-mail message.
.Subject = Forms!frmMail!Subject
.Body = Forms!frmMail!MainText
.Importance = olImportanceHigh 'High importance
'Add attachments to the e-mail message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
MyRS.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
Please Help!
Thanks in Advance!