emailling queries

[paulmcdonnell]

Hi guys,

Is there a quick way to email the content of a query as part of the text of an email, or would it have to be part of an attachment.

Any ideas...

paul

 

[BukHix]

I think there would be way to get this to work but I couldnt get it right. I am going to post what I have so far because I think that some one with some knowledge about moving around recordsets could finish it for you:

Dim rsQuery As DAO.Recordset
Dim strQuery As String
Dim EmailApp As Object
Dim NameSpace As Object
Dim EmailSend As Object

Set rsQuery = CurrentDb.OpenRecordset("MyQuery")
Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.getNameSpace("MAPI")
Set EmailSend = EmailApp.CreateItem(0)

Do While Not rsQuery.EOF

strQuery = rsQuery.Fields("JobName").Value

strQuery = strQuery + strQuery
rsQuery.MoveNext

Loop

EmailSend.To = "youremai@there.com"
EmailSend.body = strQuery
EmailSend.send

Set rsQuery = Nothing

 

[rich.barry]

Here's an example building up the body of an email from the data in a form.
Unfortunately the DoCmd.SendObject command can not be used for messages with long bodies as it causes application errors.


Private Sub cmdEMail_Click()

Dim txtstr, sqlstr, dnum, dby As String
Dim response As Integer
Dim db As ADODB.Connection
Dim Record As New ADODB.Recordset

'See this link for the full code and article
'http://support.microsoft.com/support/kb/articles/Q161/0/88.ASP

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient

If IsNull(Forms!frmdrawings!DrawingNumber) Or IsNull(Forms!frmdrawings!DrawnBy) Then
response = MsgBox("You are trying to E-mail a record containing incomplete data", vbCritical, "Error")
Exit Sub
Else
RunCommand acCmdSaveRecord
End If

Set db = CurrentProject.Connection
Record.Open "SELECT EmailTo.EMailTo FROM EmailTo;", db, adOpenKeyset, adLockOptimistic
If Record.RecordCount = 0 Then
response = MsgBox("There is no one in your E-Mail list!", vbCritical, "Error")
Exit Sub
End If
Record.Close

dnum = Forms!frmdrawings!DrawingNumber.Value
dby = Forms!frmdrawings!DrawnBy.Value
sqlstr = "SELECT Revisions.DrawingNumber, Revisions.Revision, Revisions.DateDrawn, Revisions.Remarks, Revisions.DrawnBy FROM Revisions WHERE (((Revisions.DrawingNumber)=" & Chr$(34) & dnum & Chr$(34) & ") AND ((Revisions.DrawnBy)=" & Chr$(34) & dby & Chr$(34) & "));"


txtstr = "The following drawing has been updated in the LVL CAD Database" & vbcrlf & vbcrlf
txtstr = txtstr & "Drawing Title : " & UCase(Forms!frmdrawings.DrawingTitle.Value) & vbcrlf
txtstr = txtstr & "Drawnby : " & UCase(Forms!frmdrawings.DrawnBy.Value) & vbcrlf
txtstr = txtstr & "Subcontracting to : " & UCase(Forms!frmdrawings.SubContractingTo.Value) & vbcrlf
txtstr = txtstr & "Area : " & UCase(Forms!frmdrawings.Area.Value) & vbcrlf
txtstr = txtstr & "Drawing Number : " & UCase(Forms!frmdrawings.DrawingNumber.Value) & vbcrlf
txtstr = txtstr & "File Location : " & UCase(Forms!frmdrawings.FileLocation.Value) & vbcrlf

Set db = CurrentProject.Connection
Record.Open sqlstr, db, adOpenKeyset, adLockOptimistic
If Record.RecordCount > 0 Then
Record.MoveFirst
Do Until Record.EOF
txtstr = txtstr & vbcrlf & "Revision " & UCase(Record!revision.Value) & " " & Record!DateDrawn.Value & " " & UCase(Record!remarks.Value)
Record.MoveNext
Loop
End If
Record.Close

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg

Set db = CurrentProject.Connection
Record.Open "SELECT EmailTo.EMailTo FROM EmailTo;", db, adOpenKeyset, adLockOptimistic
Record.MoveFirst
Do Until Record.EOF
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(Record!emailto.Value)
objOutlookRecip.Type = olTo
Record.MoveNext
Loop
Record.Close

' Set the Subject, Body, and Importance of the message.
.Subject = "Drawing Addition Notification"
.Body = txtstr
.Importance = olImportanceHigh 'High importance

' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next

' Send the message.
.Save
.Send
End With
Set objOutlook = Nothing

End Sub