substituting words for values in a table or another field

You could just do a series of Instr and replace tests:

If Instr(sUserInput, "[Name]") > 0 Then  Replace(sUserInput,"[Name]",<function to get name here>)
If Instr(sUserInput, "[Street]") > 0 Then  Replace(sUserInput,"[Street]",<function to get street here>)

etc

Thanks.

I tried the following code as a test...


Dim varT As Variant
Dim sUserInput As String

varT = DLookup("[ProductRef]", "PRODUCT", "[ProductRef]=" & Me!ProductRef)

If InStr(sUserInput, "[Name]") > 0 Then Replace(sUserInput, "[Name]", varT) = True

I get an error saying..
"Function call on left hand side of assignment must return Variant or Object"
..this is highlighting the Replace statement.

Also, I think this is because I have not defined sUserInput.

Obviously I want sUserInput to be the text typed into the box "CommsNotes", but I am not sure how to write this.

You are trying to assign a value to a function:

If InStr(sUserInput, "[Name]") > 0 Then Replace(sUserInput, "[Name]", varT) = True

I messed up on the example, replace is a function that returns a string:

Change to:
Dim varT As Variant
Dim sUserInput As String

varT = DLookup("[ProductRef]", "PRODUCT", "[ProductRef]=" & Me!ProductRef)

If InStr(sUserInput, "[Name]") > 0 Then sUserInput = Replace(sUserInput, "[Name]", varT)

Thanks for the correction.

However, it brings up a compile error...
"ByRef argument type mismatch"

highlighting  the "varT" in the Replace function.

I tried changing varT to varT = "testing" in case is was a problem with the DLookup, but it makes no difference.

Public Sub TestInput()
Dim sUserInput As String
Dim vName As String
Dim vDate As Date
sUserInput = "Send Sample to [Name] on [Date]"

vName = "SamIam"
vDate = #12/25/2003#

If InStr(sUserInput, "[Name]") > 0 Then sUserInput = Replace(sUserInput, "[Name]", vName)
If InStr(sUserInput, "[Date]") > 0 Then sUserInput = Replace(sUserInput, "[Date]", vDate)
'sUserInput now = "Send Sample to SamIam on 12/25/2003"
End Sub

Thanks.

But how can I get this to relate to my email form.

The form is called "CUSTOMERS email query" and there is a text box which the email message is written in by the user called "CommsNotes".

Basically I want the user to be able to type [Name] within their message and for the replace to take place.

OK, you have a button or something to send the email.  In the on click event, put code similar to this (this cant be exact, because I don't know the format of your tables).  I will assume the customer id is stored in a variable called iCustomerID and that it is a number.  If its a string, you will need to wrap it in ' in the DLookup.

If InStr(CommsNotes, "[Name]") > 0 Then
    CommsNotes= Replace(CommsNotes, "[Name]", DLookup("[Customer Name]","[Customer Table]","[Customer ID] = " & iCustomerID))
End If

Repeat that block of code for each field you want to have translated, replacing [Name] with the other fields, and changing the DLookup to get the appropriate values for them.

thanks.

This seems to work in terms of replacing the value in the text box, but as the script opens up an email in Outlook for sending, it does not replace the value in here.

I tried positioning the replace script early in the email script, but it makes no difference.

Here is the onClick element of the email script...

Private Sub cmdSendEmail_Click()
Dim lst1 As ListBox
Dim itm As Variant
Dim dteSent As Date
Dim strSubject As String
Dim strMessage As String
Dim strProductRef As String
Dim strEmployeeID As String
Dim strAttached As String
Dim strAttachments As String
Dim intAttachmentNumber As Integer
Dim intLoop As Integer
Dim boSendAnother As Boolean
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim db As Database
Dim RS As Recordset

On Error GoTo err_cmdSendEmail

    Set db = CurrentDb()
    Set RS = db.OpenRecordset("CustomerComms")

    Set lst1 = Me.lstSendSelections

    strSubject = "" & Me!EmailSubject
    strMessage = "" & Me!CommsNotes
    strProductRef = "" & Me!ProductRef
    strEmployeeID = "" & Me!EmployeeID

If InStr(CommsNotes, "[Name]") > 0 Then
    CommsNotes = Replace(CommsNotes, "[Name]", "michael")
End If

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

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

    With objOutlookMsg
        ' Set the Subject, Body, and
        .Subject = strSubject
        .Body = strMessage & vbCrLf & vbCrLf

        ' Add attachments to the message.
        If MsgBox("Do you want to add an Attachment?", 36) = vbYes Then
            boSendAnother = True
        Else
            boSendAnother = False
        End If
        Do Until boSendAnother = False
            strAttached = ahtCommonFileOpenSave()
            intAttachmentNumber = intAttachmentNumber + 1
            strAttachments = strAttachments & "Attachment " & intAttachmentNumber & " ~ " & strAttached
            Set objOutlookAttach = .Attachments.Add(strAttached)
            If MsgBox("Do you want to add another attachment?", 36) = vbNo Then
                boSendAnother = False
            End If
        Loop

        dteSent = Now()

        Do Until intLoop = lst1.ListCount    ' Select every item in the "To" list box
            intLoop = intLoop + 1
            If lst1.ListCount < intLoop Then Exit Do
            lst1.Selected(intLoop - 1) = True
        Loop

        ' Check selected items.
        For Each itm In lst1.ItemsSelected
            Select Case fraSendAs
                Case 1
                    ' Add the To recipient(s) to the message.
                    Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
                    objOutlookRecip.Type = olTo
                Case 2
                    ' Add the CC recipient(s) to the message.
                    Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
                    objOutlookRecip.Type = olCC
                Case 3
                    ' Add the BCC recipient(s) to the message.
                    Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
                    objOutlookRecip.Type = olBCC
            End Select
            RS.AddNew
            RS!CommsDate = dteSent
            RS!ContactID2 = lst1.Column(0, itm)
            RS!ProductRef = strProductRef
            RS!EmployeeCustComs = strEmployeeID
            RS!CommsNotes = strMessage
            RS!EmailSubject = strSubject
            RS!EmailAttach = "" & strAttachments
            RS!SentTo = lst1.Column(2, itm)
            RS.Update
        Next itm



        If Me.opSendNow Then ' Should we display the message before sending?
            .Send
            '.Save
        Else
            .Display
        End If
    End With

    Set objOutlook = Nothing

err_cmdSendEmail_Exit:
    RS.Close
    Set RS = Nothing
    Set db = Nothing
    Exit Sub

err_cmdSendEmail:

    Select Case Err.Number
        Case 2501   ' User canceled sending
        Case 287
            MsgBox "Email canceled or Access denied"
        Case Else
        MsgBox Err.Number & " ~ " & Err.Description
    End Select

    Resume err_cmdSendEmail_Exit

End Sub

Change this section:
   strSubject = "" & Me!EmailSubject
    strMessage = "" & Me!CommsNotes
    strProductRef = "" & Me!ProductRef
    strEmployeeID = "" & Me!EmployeeID

If InStr(CommsNotes, "[Name]") > 0 Then
    CommsNotes = Replace(CommsNotes, "[Name]", "michael")
End If


To:

    strSubject = "" & Me!EmailSubject
    strMessage = "" & Me!CommsNotes
    strProductRef = "" & Me!ProductRef
    strEmployeeID = "" & Me!EmployeeID

If InStr(strMessage , "[Name]") > 0 Then
    strMessage = Replace(strMessage , "[Name]", "michael")
End If

or do the substution before you assign it to the variables.

Thanks, that works now.

I actually want to replace [Name] with the first name of each recipient, but I don't think this is possible unless I make Outlook generate an individual email for each recipient.

If so I was going to do the replace by using a Dlookup of the FirstName field, based on the email addresses in the form.

strMessage = Replace(strMessage, "[Name]", DLookup("[FirstName]", "[CUSTOMERS]", "[Email]=" & lst1.Column(2, itm)))

However, this produces a syntax error.

any thoughts on this process, and whether it is possible?

strMessage = Replace(strMessage, "[Name]", DLookup("[FirstName]", "[CUSTOMERS]", "[Email]='" & lst1.Column(2, itm) & "'"))


Strings passed in the Where clause need to be surrounded by single quotes (')

Thanks.

That works now.

Can you advice me on the best way to do the replace for each recipient.

I was thinking that if the user types a tag such as [Name] the script runs an alternative version which generates an email for each recipient and uses the replace/dlookup method for each.

Sorry about the delay in replying!

Thanks for the code.

Firstly I removed the "o" from the Db and RS references as I already had these referenced in the declarations as Db = CurrentDB()  etc, etc

It actually generates lots of emails, and so I had to exit Access to stop it.

I think what is happening is that the RS.OEF line is making it loop around until it goes through every entry in the CustomerComms table, whilst generating all of the emails to the recipients in the query.

Somehow I need to get it to generate an email for each recipient in the "lstSendSelections" list box, and therefore not relating the loop function to the CustomerComms table (as this is just for logging each email which is sent).

In the email onClick event, there are references to this list box for looping through the contents of it to add the recipients to the email...

(I did not write this code, so i do not understand every single detail of it!)

It sets the variable...
Set lst1 = Me.lstSendSelections

Then in the following section of the script it uses a loop function to go through each of the recipients. I think that I need to use something similar to change the script so that instead of going through the receipients list to add each one to the email, it creates a new email for each recipient...

        Do Until intLoop = lst1.ListCount    ' Select every item in the "To" list box
            intLoop = intLoop + 1
            If lst1.ListCount < intLoop Then Exit Do
            lst1.Selected(intLoop - 1) = True
        Loop

        ' Check selected items.
        For Each itm In lst1.ItemsSelected
            Select Case fraSendAs
                Case 1
                    ' Add the To recipient(s) to the message.
                    Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
                    objOutlookRecip.Type = olTo
                Case 2
                    ' Add the CC recipient(s) to the message.
                    Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
                    objOutlookRecip.Type = olCC
                Case 3
                    ' Add the BCC recipient(s) to the message.
                    Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
                    objOutlookRecip.Type = olBCC
            End Select
            RS.AddNew
            RS!CommsDate = dteSent
            RS!ContactID2 = lst1.Column(0, itm)
            RS!ProductRef = strProductRef
            RS!EmployeeCustComs = strEmployeeID
            RS!CommsNotes = strMessage
            RS!EmailSubject = strSubject
            RS!EmailAttach = "" & strAttachments
            RS!SentTo = lst1.Column(2, itm)
            RS.Update
        Next itm

lludden,

do you know how I can best proceed with this?

Cheers.

      Do Until intLoop = lst1.ListCount    ' Select every item in the "To" list box
            intLoop = intLoop + 1
            If lst1.ListCount < intLoop Then Exit Do
            lst1.Selected(intLoop - 1) = True
        Loop

        ' Check selected items.
        For Each itm In lst1.ItemsSelected
            Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
            objOutlookRecip.Type = olTo
            .Send 'Just Send message
            RS.AddNew 'now log that its been sent
            RS!CommsDate = dteSent
            RS!ContactID2 = lst1.Column(0, itm)
            RS!ProductRef = strProductRef
            RS!EmployeeCustComs = strEmployeeID
            RS!CommsNotes = strMessage
            RS!EmailSubject = strSubject
            RS!EmailAttach = "" & strAttachments
            RS!SentTo = lst1.Column(2, itm)
            RS.Update
        Next itm

Thanks.

If I try to send a message to more than one receipient it does not work. It sends the first email OK, but then when it loops through the section of code below for the second time (to send email to the second recipient on the list) it fails...

At the line             Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
it has the correct value (their email address), but then it jumps into the error handling and brings up the error "The item has been moved or deleted".


        ' Check selected items.
        For Each itm In lst1.ItemsSelected
            Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
            objOutlookRecip.Type = olTo
            .Send 'Just Send message
            RS.AddNew 'now log that its been sent
            RS!CommsDate = dteSent
            RS!ContactID2 = lst1.Column(0, itm)
            RS!ProductRef = strProductRef
            RS!EmployeeCustComs = strEmployeeID
            RS!CommsNotes = strMessage
            RS!EmailSubject = strSubject
            RS!EmailAttach = "" & strAttachments
            RS!SentTo = lst1.Column(2, itm)
            RS.Update
        Next itm

Ok, make a subrouting that sends the message.

Public Sub SendMessage( Recipient, Subject, Body )
<put your code to send a single message in here>
End Sub

Then in your loop, just call SendMessage(lst1.Column(2,itm),strSubject, strBody)

Thanks.

I tried the following as a subroutine...

Public Sub SendMessage(Recipient, Subject, Body)
Dim itm As Variant
Dim lst1 As ListBox

        For Each itm In lst1.ItemsSelected
            Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
            objOutlookRecip.Type = olTo
            rs.AddNew 'now log that its been sent
            rs!CommsDate = dteSent
            rs!ContactID2 = lst1.Column(0, itm)
            rs!ProductRef = strProductRef
            rs!EmployeeCustComs = strEmployeeID
            rs!CommsNotes = strMessage
            rs!EmailSubject = strSubject
            rs!EmailAttach = "" & strAttachments
            rs!SentTo = lst1.Column(2, itm)
            rs.Update
            .Send 'Just Send message
        Next itm
End Sub

However, the code stops on ".Recipients" and says "invalid or unqualified reference".

I tried declaring the Outlook variables in the subroutine...

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

but it makes no difference!

The complete code now reads....

Private Sub cmdSendEmail_Click()
Dim EmailType As Variant
Dim lst1 As ListBox
Dim itm As Variant
Dim dteSent As Date
Dim strSubject As String
Dim strMessage As String
Dim strProductRef As String
Dim strEmployeeID As String
Dim strAttached As String
Dim strAttachments As String
Dim intAttachmentNumber As Integer
Dim intLoop As Integer
Dim boSendAnother As Boolean
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim db As Database
Dim rs As Recordset

On Error GoTo err_cmdSendEmail

    Set db = CurrentDb()
    Set rs = db.OpenRecordset("CustomerComms")
   
    Set lst1 = Me.lstSendSelections

    strSubject = "" & Me!EmailSubject
    strMessage = "" & Me!CommsNotes
    strProductRef = "" & Me!ProductRef
    strEmployeeID = "" & Me!EmployeeID

If InStr(strMessage, "[Name]") > 0 Then
    strMessage = Replace(strMessage, "[Name]", DLookup("[FirstName]", "[CUSTOMERS]", "[Email]='" & lst1.Column(2, itm) & "'"))
    EmailType = "1" 'set boolean value to "1" if we are using the replace method and therefore wish to send emails individually
    Else
    End If
   
' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    With objOutlookMsg
        'Set the Subject, Body, and
        .Subject = strSubject
        .Body = strMessage & vbCrLf & vbCrLf


        ' Add attachments to the message.
        If MsgBox("Do you want to add an Attachment?", 36) = vbYes Then
            boSendAnother = True
        Else
            boSendAnother = False
        End If
        Do Until boSendAnother = False
            strAttached = ahtCommonFileOpenSave()
            intAttachmentNumber = intAttachmentNumber + 1
            strAttachments = strAttachments & "Attachment " & intAttachmentNumber & " ~ " & strAttached
            Set objOutlookAttach = .Attachments.Add(strAttached)
            If MsgBox("Do you want to add another attachment?", 36) = vbNo Then
                boSendAnother = False
            End If
        Loop

        dteSent = Now()
'check whether we are using the replace method and if so use individual email method
If EmailType > 0 Then

        Do Until intLoop = lst1.ListCount    ' Select every item in the "To" list box
            intLoop = intLoop + 1
            If lst1.ListCount < intLoop Then Exit Do
            lst1.Selected(intLoop - 1) = True
        Loop
Call SendMessage(lst1.Column(2, itm), strSubject, strMessage)

Else
        Do Until intLoop = lst1.ListCount    ' Select every item in the "To" list box
            intLoop = intLoop + 1
            If lst1.ListCount < intLoop Then Exit Do
            lst1.Selected(intLoop - 1) = True
        Loop

        ' Check selected items.
        For Each itm In lst1.ItemsSelected
            Select Case fraSendAs
                Case 1
                    ' Add the To recipient(s) to the message.
                    Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
                    objOutlookRecip.Type = olTo
                Case 2
                    ' Add the CC recipient(s) to the message.
                    Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
                    objOutlookRecip.Type = olCC
                Case 3
                    ' Add the BCC recipient(s) to the message.
                    Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
                    objOutlookRecip.Type = olBCC
            End Select
            rs.AddNew
            rs!CommsDate = dteSent
            rs!ContactID2 = lst1.Column(0, itm)
            rs!ProductRef = strProductRef
            rs!EmployeeCustComs = strEmployeeID
            rs!CommsNotes = strMessage
            rs!EmailSubject = strSubject
            rs!EmailAttach = "" & strAttachments
            rs!SentTo = lst1.Column(2, itm)
            rs.Update
        Next itm
End If

        If Me.opSendNow Then ' Should we display the message before sending?
            .Send
            '.Save
        Else
            .Display
        End If
    End With

    Set objOutlook = Nothing

err_cmdSendEmail_Exit:
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Sub

err_cmdSendEmail:

    Select Case Err.Number
        Case 2501   ' User canceled sending
        Case 287
            MsgBox "Email canceled or Access denied"
        Case Else
        MsgBox Err.Number & " ~ " & Err.Description
    End Select

    Resume err_cmdSendEmail_Exit

End Sub
Public Sub SendMessage(Recipient, Subject, Body)
Dim itm As Variant
Dim lst1 As ListBox

        For Each itm In lst1.ItemsSelected
            Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
            objOutlookRecip.Type = olTo
            rs.AddNew 'now log that its been sent
            rs!CommsDate = dteSent
            rs!ContactID2 = lst1.Column(0, itm)
            rs!ProductRef = strProductRef
            rs!EmployeeCustComs = strEmployeeID
            rs!CommsNotes = strMessage
            rs!EmailSubject = strSubject
            rs!EmailAttach = "" & strAttachments
            rs!SentTo = lst1.Column(2, itm)
            rs.Update
            .Send 'Just Send message
        Next itm
End Sub

OK.

I think the problem is that when it loops back to do the next email, it does not have the command to create a new email item in Outlook....

        For Each itm In lst1.ItemsSelected
            Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))
            objOutlookRecip.Type = olTo
            rs.AddNew 'now log that its been sent
            rs!CommsDate = dteSent
            rs!ContactID2 = lst1.Column(0, itm)
            rs!ProductRef = strProductRef
            rs!EmployeeCustComs = strEmployeeID
            rs!CommsNotes = strMessage
            rs!EmailSubject = strSubject
            rs!EmailAttach = "" & strAttachments
            rs!SentTo = lst1.Column(2, itm)
            rs.Update
            .Send 'Just Send message
        Next itm

But if I put...
        Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

...in the top of the For...Each statement, it does not help. Fails on the line...

Set objOutlookRecip = .Recipients.Add(lst1.Column(2, itm))

and says "The item has been moved or deleted"

I will work this later today and post you the code to do what you need.

Thanks.

hi lluden,

did you have chance to look at this again?
cheers, and sorry for the trouble!

No comment has been added lately, so it's time to clean up this TA.
I will leave the following recommendation for this question in the Cleanup topic area:

Accept: lludden {http:#9780073}

Please leave any comments here within the next seven days.
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!

stevbe
EE Cleanup Volunteer