Hi,
My company is moving to Outlook soon from Notes. I'd like to know how to change the below code to send from Outlook instead of Notes. This code sends an access table (table1) to a list of recipients every hour. The table is placed directly inside the body of the email. Its a small 4 record table. It sends automatically without any prompts, doesn't open the email client...it just sends. I didn't write this code as it was in existence before I came aboard and I have very little vb experience.
Is there anyway to replicate this to send via Outlook automatically without displaying or any prompts? Any help would be greatly appreciated.
My company is moving to Outlook soon from Notes. I'd like to know how to change the below code to send from Outlook instead of Notes. This code sends an access table (table1) to a list of recipients every hour. The table is placed directly inside the body of the email. Its a small 4 record table. It sends automatically without any prompts, doesn't open the email client...it just sends. I didn't write this code as it was in existence before I came aboard and I have very little vb experience.
Is there anyway to replicate this to send via Outlook automatically without displaying or any prompts? Any help would be greatly appreciated.
Code:
Option Compare Database
Public myWord
Function SendMail1()
If Hour(Now) > 0 And Hour(Now) < 7 Then
DoCmd.Quit
End If
Dim Conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim doc As Word.Document
Dim strSQL As String
Dim varRst As Variant
Dim f As Variant
Dim strHead As String
Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object
Dim richtext As Object
Set Conn = New ADODB.Connection
Set rst = New ADODB.Recordset
Conn.Provider = "Microsoft.Ace.OLEDB.12.0;" & "Data Source=" & _
CurrentProject.Path & _
"\Database51.accdb"
strSQL = "SELECT *FROM TABLE1"
Conn.Open
rst.Open strSQL, Conn, adOpenUnspecified, adLockUnspecified, adCmdText
If Not rst.EOF Then
varRst = rst.GetString(, , vbTab, vbCrLf)
For Each f In rst.Fields
strHead = strHead & f.Name & vbTab
Next
End If
Set Session = CreateObject("Lotus.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
'Call Session.Initialize("Pacific0")
'or use below to supply password of the current ID
Call Session.Initialize("xxxxxxx")
'Open the mail database in notes
Set Maildb = Session.GetDatabase("OMSNM1/Company", "mail\user.nsf")
If Not Maildb.IsOpen = True Then
Call Maildb.Open
End If
'Create the mail document
Set MailDoc = Maildb.CreateDocument
Call MailDoc.ReplaceItemValue("Form", "Memo")
'Set the recipient
Call MailDoc.ReplaceItemValue("SendTo", Array("address1@company.com", "address2@company.com", "address3@company.com"))
'Set subject
Call MailDoc.ReplaceItemValue("Subject", "Service Report" & " " & "-" & " " & Format(Now(), "hh:mm am/pm"))
'Create and set the Body content
Set Body = MailDoc.CreateRichTextItem("Body")
'Call MailDoc.ReplaceItemValue("Body", strHead)
Call Body.AddNewLine(2)
Call Body.AppendText(strHead & vbCrLf & " " & varRst)
'Call MailDoc.ReplaceItemValue("Body", varRst)
Dim strAttachment As String
strAttachment = strSQL
'Example to create an attachment (optional)
'Call Body.AddNewLine(2)
'Set NotesEmbeddedObject = NotesRichTextItem.EmbedObject(1453, "", varRst, "")
'Example to save the message (optional)
MailDoc.SaveMessageOnSend = True
'Send the document
'Gets the mail to appear in the Sent items folder
Call MailDoc.ReplaceItemValue("PostedDate", Now())
Call MailDoc.Send(False)
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set Body = Nothing
Set Session = Nothing
End Function
