Using a filter with Sendobject

tbathgate

New member
Local time
Today, 09:28
Joined
Sep 14, 2006
Messages
3
Hi Guys,

I was wondering if anyone could help me at all.

I have set up a enquiry log database for logging enquiries and informatino about them. What i want is to be ble to pass the enquir on to the relevant person.

I have set up a button with a sendobject macro on it that will create an html page, with a subject and message body and then I can enter the email address of the person.

This all works fine but the down side is that it sends every record in the table and I only want it to send the current record that the form is displaying. I have tried filters but and not sure how you set up them up to say current.

Can anyone shed some light on this? I run Access and Outlook 2003, and am I understand VB code a bit.

Another cheeky question as well. When how do you got about creating an html template? I have designed a table layout for this and need to know how to tell access to put information in the right fields?

Many Thanks in advance
 
A Macro !!!

tbathgate said:
I have set up a button with a sendobject macro on it that will create an html page, with a subject and message body and then I can enter the email address of the person.

First bin the Macro. You don't want to start coding with these as when you migrate forwards it won't work.
The easiest and quickest way to build the HTML page for your email is to deisgn it in an HTML editor. (Word will do). Then look at the source code and copy it to series of strings. strEMailHeader = Top section. like this
Code:
txtMessage = "<html><body bgcolor=""#F4FFFF"" text=""#000000"" style='font-size:10.0pt;font-family:Arial'><img src=""http://www.Yourwebsite.co.uk/images/logo1.jpg"" align=""right"" width=""150"" height=""115""><br><br><b>" & UCase(strHeader) & "</b><br><br><br><br>For the attention of <b>" & Me.ContactName & "</b> - " & Me.ContactJobTitle & "<br><br>This message is to confirm your Booking; Our Reference <b>" & Me.BookingRef & "</b><br>Date the booking was taken <b>" & Me.BookingDate & "</b><br>Your Booking Reference <b>" & Me.BookingRefAuth & "</b><br>"
You can see a variety of insertions here. Some from the Form you send this from (Me.Field) and some from a recordset called from "Select * from TblCustomer where ID = "& Me.ID

You then continue to build the HTML to your spec.

Then call a function.
Code:
Call SetupCDOEmail(Me.BookingDate & " - " & strCustomer & " - Our Company Booking Confirmation", txtMessage, Me.EmailAddress, "K:\strattachments")

This is a cut down version of the function.
Code:
Public Sub SetupCDOEmail(ByVal strSubject As String, ByVal strMsg As String, ByVal strAddress As String, ByVal strAttachPath As String)
    
On Error GoTo SetupCDOEmail_err

Dim objEmail As Object
Dim objConf As Object
Dim objFields As Object
Dim objWord As Word.Application
Dim sFrom
Dim strBToAddress
  

''''''' This gets the email address of the current user for a copy email and reply.
Dim rst As adodb.Recordset
Set rst = New adodb.Recordset
rst.Open "SELECT tblUsers.* From tblUsers WHERE (((tblUsers.UserName)='" & userGetCurrent & "'));", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If Not IsNull(rst!Email) And rst!Email <> "" Then
    sFrom = rst!Email
Else
    sFrom = "info@YourDomain.co.uk"
End If
rst.Close
Set rst = Nothing
'''''''''
   
Set objEmail = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")
Set objFields = objConf.Fields
        
objFields.Item(cdoSendUsingMethod) = cdoSendUsingPickup
objFields.Item(cdoSMTPServerPickupDirectory) = StrMailServer 'Path to the Exhange Pickup directory
objFields.Item(cdoFlushBuffersOnWrite) = True
objFields.Item(cdoSendEmailAddress) = sFrom '
objFields.Update

Set objEmail.Configuration = objConf
objEmail.From = sFrom
objEmail.Subject = strSubject
   
If InStr(LCase(strMsg), "<html") > 0 Then objEmail.HTMLBody = strMsg Else objEmail.TextBody = strMsg

objEmail.To = strAddress
objEmail.BCC = sFrom

'Check for an attachment
If Not (IsNull(strAttachPath) Or Len(strAttachPath) = 0) Then
    'close here the word application
    'check if Word is running and set Word object
    If CheckWord() = 0 Then
       Set objWord = CreateObject("Word.Application")
    Else
       Set objWord = GetObject(, "Word.Application")
    End If
On Error Resume Next
    objWord.Activate
On Error Resume Next
    objWord.ActiveDocument.Close SaveChanges:=wdSaveChanges '0
    objWord.Application.Quit
    Set objWord = Nothing
    objEmail.AddAttachment (strAttachPath)
End If
    
objEmail.Send

Set objEmail = Nothing
Set objFields = Nothing
Set objConf = Nothing

 
GoTo EndOfSub
        
Exit Sub

SetupCDOEmail_err:
        MsgBox "Error in sub SetupCDOEmail(): " & Error, vbExclamation + vbOKOnly, "Warning"
        GoTo EndOfSub
    
GoTo EndOfSub

EndOfSub:
    Exit Sub
    
End Sub

Have fun.......
 
Thanks for your reply

Hi brian,

thanks for your detailed reply.

I'm not sure i follow it 100%.

I think for the time i just want to focus on the send email part of it.

I have tried to use the code you provided but i'm having difficulties following it.

Is there any chance you or anyone else can help me by breaking it down a bit:

1. get the current record
2. creates the attachment
3 opens new email containing subject and message.

It would be much appreciated

Thanks

Tom
 
My Solution

Hey All,

I managed to work out a solution to my problem using some of the code suggested by Brian.

I wanted to share it so that it may help other in the future. Its not perfect and there are probably a lot shorter way of doing it but it works for me!.

Code:
Private Sub PassEnquiry_Click()

    On Error GoTo Err_PassEnquiry_Click

    Dim strText As String        '-- E-mail text
    Dim strContactName As String      '-- Name e-mail text
    Dim strOrganisation As String    '--Organisation email text
    Dim strDateCall As String        '--Date the call was taken
    Dim strCallTaken As String       '--Call taken by
    Dim strStatus As String          '-- status of the call
    Dim strRequestType As String     '--The type of information request
    Dim strNotes As String           '--notes relating to the enquiry
    Dim strTelephone As String       '-- the telephone number
    Dim strEmail As String           '-- the email address
    Dim strPassedDate As String      '-- the date the enquiry was passed
    Dim strSubject As String     '-- Subject line of e-mail
      
    Dim strSQL As String        '-- Create SQL update statement
    Dim errLoop As Error
    
    strContactName = Me.ContactName
    strOrganisation = Me.Organisation
    strDateCall = Me.DateOfCall
    strCallTaken = Me.CallTakenBy
    strStatus = Me.EnquiryStatus
    strRequestType = Me.InformationRequestType
    strNotes = Me.Notes
    strTelephone = Me.Telephone
    strEmail = Me.Email
    strPassedDate = Me.PassedToDate
       
        stSubject = "A New enquiry has been received"
     
   stText = "A New enquiry has ben received" & Chr$(13) & Chr$(13) & _
             "Date of Call: " & strDateCall & Chr$(13) & Chr$(13) & _
             "Organisation: " & strOrganisation & Chr$(13) & Chr$(13) & _
             "Contact Name: " & strContactName & Chr$(13) & Chr$(13) & _
             "Telephone Number: " & strTelephone & Chr$(13) & Chr$(13) & _
             "Email Address: " & strEmail & Chr$(13) & Chr$(13) & _
             "Call Taken By: " & strCallTaken & Chr$(13) & Chr$(13) & _
             "Enquiry Status: " & strStatus & Chr$(13) & Chr$(13) & _
             "Information Request Type: " & strRequest & Chr$(13) & Chr$(13) & _
             "Notes: " & strNotes & Chr$(13) & Chr$(13) & _
             "Date Passed: " & strPassedDate & Chr$(13) & Chr$(13) & _
             "Please remember to update the enquiry log when you have dealt with this request."
    
        'Write the e-mail content for sending to assignee
        DoCmd.SendObject , , acFormatTXT, , , , stSubject, stText, -1
    
        
        On Error GoTo Err_Execute
        CurrentDb.Execute strSQL, dbFailOnError
        On Error GoTo 0
    
        Exit Sub
    
Err_Execute:
    
        ' Notify user of any errors that result from
        ' executing the query.
        If DBEngine.Errors.Count > 0 Then
            For Each errLoop In DBEngine.Errors
                MsgBox "Error number: " & errLoop.Number & vbCr & _
                       errLoop.Description
            Next errLoop
        End If
    
        Resume Next
    
Exit_PassEnquiry_Click:
        Exit Sub
    
Err_PassEnquiry_Click:
        MsgBox Err.Description
        Resume Exit_PassEnquiry_Click
    
    End Sub

thanks

Tom
 

Users who are viewing this thread

Back
Top Bottom