asked on

Regarding placing a button in a email text

Hello everybody,
I am working in MS ACcess database. I have a button in my database to send emails through MS Outlook. I am using the function "voting option" for the user to select.
Now if the receiver selects "yes" or "no", then a reply comes back to a sender.
For some reason, some receivers can not see the buttons for voting option(maybe they are using different application then MS Outlook).
So, now I am trying to make my own two buttons ("yes" and "no") in the outlook message. And i want receiver, to click on one of this button and a reply should come back to actual sender.
Is it possible to make buttons in the email body which is actually coming from my database??
If yes, then can anybody advise me about how to do it??
Thanx in advance

therealmongoose

HI,

I've not done this before, but I believe you should be able to do it by declaring an outlook object in vba, then using a bespoke mail sender. You then get visibility of the voting options of the mail item.

This method would therefore replace the docmd.sendobject method.
Please see below some code that sends mails, you would need to lookinto m_item.votingoptions to progress...
Sorry can't provide a more definitive solution at this stage...

Option Compare Database
Option Explicit

' Declare module level variables
Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Dim mFolder As MAPIFolder
Dim mItem As MailItem
Dim fSuccess As Boolean

' Module contains only 2 methods:
'    1) GetOutlook()
'    2) SendMessage()
'
Private Function GetOutlook() As Boolean
' The GetOutlook() function sets the Outlook Application
' and Namespase objects and opens MS Outlook
On Error Resume Next

' Assume success
fSuccess = True

Set mOutlookApp = GetObject("", "Outlook.application")

' If Outlook is NOT Open, then there will be an error.
' Attempt to open Outlook
If Err.Number > 0 Then
    Err.Clear
    Set mOutlookApp = CreateObject("Outlook.application")
        
    If Err.Number > 0 Then
         WriteToLogFile "Could not create Outlook object"
        'MsgBox "Could not create Outlook object", vbCritical
        
        fSuccess = False
        Exit Function
    End If
End If

' If we've made it this far, we have an Outlook App Object
' Now, set the NameSpace object to MAPI Namespace
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
    
If Err.Number > 0 Then
    
    WriteToLogFile "Could not create Outlook object"
    'MsgBox "Could not create NameSpace object", vbCritical
    fSuccess = False
    Exit Function
End If

' Return the Success Flag as the value of GetOutlook()
GetOutlook = fSuccess
    
End Function


Public Function SendMessage(str_Subject As String, strRecipient As String, strBody As String, strAttachmentPath As String) As Boolean
' The SendMessage() function reads user entered values and
' actually sends the message.

On Error Resume Next

Dim strRecip As String
Dim strSubject As String
Dim strMsg As String
Dim strAttachment As String
Dim varRecipients As Variant
Dim varItem As Variant

strSubject = str_Subject
strRecip = strRecipient
strMsg = strBody
strAttachment = strAttachmentPath

' Any amount of validation could be done at this point, but
' at a minimum, you need to verify that the user supplied an
' Email address for a recipient.

If Len(strRecip) = 0 Then
    strMsg = "You must designate a recipient."
    'MsgBox strMsg, vbExclamation, "Error"
    WriteToLogFile strMsg
    Exit Function
End If

' Assume success
fSuccess = True

varRecipients = fncCsvToArray(strRecipient, 59)


' Here's where the real Outlook Automation takes place
If GetOutlook = True Then
    Set mItem = mOutlookApp.CreateItem(olMailItem)
    
    For Each varItem In varRecipients
        mItem.recipients.Add Trim(varItem)
    Next varItem
    
    mItem.Subject = strSubject
    mItem.Body = strMsg
    
    ' This code allows for 1 attachment, but with slight
    ' modification, you could provide for multiple files.
    If Len(strAttachment) > 0 Then
        mItem.Attachments.Add strAttachment
    End If
    
    
    mItem.Save
    mItem.Send
End If

' Release resources
Set mOutlookApp = Nothing
Set mNameSpace = Nothing

If Err.Number > 0 Then fSuccess = False
SendMessage = fSuccess

End Function

Open in new window

dqmq

If you send your email in HTML format, you could embed a Yes link and a No link that engage the default mail client. You can probably alter it to display a button, as well.

<a href="mailto:john@whereever.com?subject=Important Vote&body=Yes! ">YES</a>

John_BAS

ASKER

Hi dqmq,
"mailto:john@whereever.com?", should be the email of a person, to whome the reply should come after receiver click on "yes" or "no"???

John_BAS

ASKER

Hi dqmq,
I have attached my HTML code for email text.
It is giving me error message if i put ur line in my code.
Any advize plz??

sEmailText = sEmailText & Me.TekenbevoegdeNaam
        sEmailText = sEmailText & "," & "<br><br>"
        sEmailText = sEmailText & "Bedankt voor uw opdracht!" & "<br>"
        sEmailText = sEmailText & "<br>"
        sEmailText = sEmailText & "Hierbij ontvangt u de bijbehorende consultancy- en detacheringovereenkomst." & "<br>"
        sEmailText = sEmailText & "<br>"
        sEmailText = sEmailText & "<ul><li><u>U bent akkoord</u>: bevestig dit middels het beantwoorden van de mail met 'akkoord'." & "<br><br>"
        sEmailText = sEmailText & "<li><u>U heeft vragen</u>: geef dit aan middels het." & "</ul>"
        sEmailText = sEmailText & "De wijze van elektronische ondertekening wordt door u gezien als een betrouwbare vorm van elektronisch ondertekenen." & "<br>"
        sEmailText = sEmailText & "<br>"
        sEmailText = sEmailText & "Wij vertrouwen op een prettige samenwerking!" & "<br>"
        sEmailText = sEmailText & "<br>"
        sEmailText = sEmailText & "Met vriendelijke groet,"

Open in new window

therealmongoose

Ok here's the code amended so it works...
To use it you need a reference set to the outlook library in vba (tools>references)
to call the code use:
SendMessage "Title","Recipients@yourdestination.com","Message Body", "attachment path (leave as empty string if no attch.", "VoteReturnAddress@yourdestination.com"

Option Compare Database
Option Explicit

' Declare module level variables
Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Dim mFolder As MAPIFolder
Dim mItem As MailItem
Dim fSuccess As Boolean

Private Function GetOutlook() As Boolean

' The GetOutlook() function sets the Outlook Application
' and Namespase objects and opens MS Outlook
On Error Resume Next

' Assume success
fSuccess = True

Set mOutlookApp = GetObject("", "Outlook.application")

' If Outlook is NOT Open, then there will be an error.
' Attempt to open Outlook
If Err.Number > 0 Then
    Err.Clear
    Set mOutlookApp = CreateObject("Outlook.application")
        
    If Err.Number > 0 Then
       '  WriteToLogFile "Could not create Outlook object"
        'MsgBox "Could not create Outlook object", vbCritical
        
        fSuccess = False
        Exit Function
    End If
End If

' If we've made it this far, we have an Outlook App Object
' Now, set the NameSpace object to MAPI Namespace
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
    
If Err.Number > 0 Then
    
   ' WriteToLogFile "Could not create Outlook object"
    'MsgBox "Could not create NameSpace object", vbCritical
    fSuccess = False
    Exit Function
End If

' Return the Success Flag as the value of GetOutlook()
GetOutlook = fSuccess
    
End Function


Public Function SendMessage(str_Subject As String, strRecipient As String, strBody As String, strAttachmentPath As String, strReturnAddress As String) As Boolean
' The SendMessage() function reads user entered values and
' actually sends the message.

On Error Resume Next

Dim strRecip As String
Dim strSubject As String
Dim strMsg As String
Dim strAttachment As String
Dim varRecipients As Variant
Dim varItem As Variant

strSubject = str_Subject
strRecip = strRecipient
strMsg = strBody
strAttachment = strAttachmentPath

' Any amount of validation could be done at this point, but
' at a minimum, you need to verify that the user supplied an
' Email address for a recipient.

If Len(strRecip) = 0 Then
    strMsg = "You must designate a recipient."
    'MsgBox strMsg, vbExclamation, "Error"
    'WriteToLogFile strMsg
    Exit Function
End If

' Assume success
fSuccess = True

varRecipients = fncCsvToArray(strRecipient, 59)


' Here's where the real Outlook Automation takes place
If GetOutlook = True Then
    Set mItem = mOutlookApp.CreateItem(olMailItem)
    
    For Each varItem In varRecipients
        mItem.recipients.Add Trim(varItem)
    Next varItem
    
    mItem.Subject = strSubject
    mItem.Body = strMsg
    
    ' This code allows for 1 attachment, but with slight
    ' modification, you could provide for multiple files.
    If Len(strAttachment) > 0 Then
        mItem.Attachments.Add strAttachment
    End If
    
    mItem.VotingOptions = "Yes;No"
    mItem.VotingResponse = strReturnAddress
    
    mItem.Save
    mItem.Send
End If

' Release resources
Set mOutlookApp = Nothing
Set mNameSpace = Nothing

If Err.Number > 0 Then fSuccess = False
SendMessage = fSuccess

End Function
' -- End Code Here -->



Function fncCsvToArray(strDataLine As String, intDelimiter, Optional intTextQual As Integer) As Variant
    
    '==============================
    'Title: CSV Data Parser
    'Author: Tim Watts
    'Date: 27/11/2007
    'Purpose: Accepts line of delimited data, ascii code of delimiter, optional
    'ascii code of text qualifier. Parses data into array and returns
    'variant variable containing parsed data.
    '==============================
    
    Dim strField() As String
    Dim booDelimit As Boolean
    Dim x As Integer
    Dim y As Integer
    Dim intParseMethod As Integer
    Dim varItem As Variant
    
    ReDim strField(0)
    booDelimit = False
    
    y = 1
    
    If IsMissing(intTextQual) Then
        intParseMethod = 1
    ElseIf InStr(strDataLine, Chr(intTextQual)) = 0 Then
        intParseMethod = 1
    Else
        intParseMethod = 2
    End If
    
    Select Case intParseMethod
    
        Case 1
            'text qualifier not supplied in arguments
            'or is supplied but not present in data
            For x = 1 To Len(strDataLine)
                If Mid(strDataLine, x, 1) = Chr(intDelimiter) Then
                    strField(UBound(strField)) = Mid(strDataLine, y, x - y)
                    y = x + 1
                    ReDim Preserve strField(UBound(strField) + 1)
                End If
            Next x
            
            'last item of data!!
            strField(UBound(strField)) = Mid(strDataLine, y, Len(strDataLine) - y + 1)
        
        Case 2
            'text qualifier supplied in arguments
            'and present in data
            For x = 1 To Len(strDataLine)
                If Mid(strDataLine, x, 1) = Chr(intTextQual) Then
                    booDelimit = Not booDelimit
                    If booDelimit Then
                        y = y + 1
                    End If
                End If
                If Mid(strDataLine, x, 1) = Chr(intDelimiter) Then
                    If Not booDelimit Then
                        strField(UBound(strField)) = Mid(strDataLine, y, x - y - 1)
                        y = x + 1
                        ReDim Preserve strField(UBound(strField) + 1)
                    End If
                End If
            Next x
            
            strField(UBound(strField)) = Mid(strDataLine, y, Len(strDataLine) - y)
        
    End Select
    
    'ReDim Preserve strField(UBound(strField) - 1)
    
    For Each varItem In strField
        'Debug.Print varItem
        varItem = Replace(varItem, Chr(34), "")
        'Debug.Print varItem
    Next varItem
    
    
    fncCsvToArray = strField
    
End Function

Open in new window

John_BAS

ASKER

Hi the realmongoose,
I am trying everything out. I will let you know if i come up with solution.
Thanx for reply.

John_BAS

ASKER

hi therealmongoose,
As I can see in the code, you have given voting options and the email adress for the reply to come.

Actually its already working fine with me. My only concern is that some people can not see these voting buttons. So I was thinking that if I can show these voting options in email body, which would be clearly visible. Is that possible??

Thanx

dqmq

I put the attached string in an html email and sent it to myself. I get an email with two links, one for voting yes and the other for voting no. When I click on a link it opens up an email with "millerdq@gmail.com" in the To: line. That's should be the email of the person you want the questionare responses sent to.

If you're good at HTML, you almost certainly make it display buttons instead of links. I expect you can also automatically send the email rather than going into composition mode. But I'm not an html guru, so someone else could probably help with that.

At this point it's really an HTML question, so you may have better luck in a different forum.

Is is possible to put buttons in an email body?
<p>
<a href="mailto:millerdq@gmail.com?subject=Questionaire
&body=Yes">Click Here to respond yes</a>
<p>
<a href="mailto:millerdq@gmail.com?subject=Questionaire
&body=No">Click Here to respond no</a>

Open in new window

ASKER CERTIFIED SOLUTION

therealmongoose

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

John_BAS

ASKER

Hello dqmq,
The code that you have provided is working fine in html.
But its just not fitting in MS ACcess code.
As i said earlier my email body text is html and i have added your code next to it and made adjustments according to my system. But it gives me error message that instruction is expecting end...

Hereby is how my html text looks like now after putting your code...
Can you plz check about why MS Access is showing syntaxt fault??
Thanx a lot

sEmailText = sEmailText & Me.TekenbevoegdeNaam
        sEmailText = sEmailText & "," & "<br><br>"
        sEmailText = sEmailText & "Bedankt voor uw opdracht!" & "<br>"
        sEmailText = sEmailText & "<br>"
        sEmailText = sEmailText & "Hierbij ontvangt u de bijbehorende consultancy- en detacheringovereenkomst. " & "<br>"
        sEmailText = sEmailText & "<br>"
        sEmailText = sEmailText & "<ul><li><u>U bent akkoord</u>: bevestig dit middels het beantwoorden van de mail met 'akkoord'." & "<br><br>"
        sEmailText = sEmailText & "<li><u>U heeft vragen</u>: geef dit aan middels het beantwoorden van de mail met 'niet akkoord'." & "</ul>"
        sEmailText = sEmailText & "De wijze van elektronische." & "<br>"
        sEmailText = sEmailText & "<br>"
        sEmailText = sEmailText & "Wij vertrouwen op een prettige samenwerking!" & "<br>"
        sEmailText = sEmailText & "<br><br>"
        sEmailText = sEmailText & "<a href="mailto:millerdq@gmail.com?subject=Questionaire&body=Yes">Click Here to respond yes</a><p><a href="mailto:millerdq@gmail.com?subject=Questionaire&body=No">Click Here to respond no</a>"
        sEmailText = sEmailText & "Met vriendelijke groet,"

Open in new window

John_BAS

ASKER

Hello dqmq,
the syntax error is pointing towards "mailto", "subject". Is there anything that i need to declare or??
Any advice plz?

John_BAS

ASKER

Hello everybody,
this solution is working fine with me.
Now i only have one issue left.
The return email to "millerdq@gmail.com" is using "Questionaire" as a subject.
Can this return email use the same subject as defined in the email that i send??
Actually this subject is a combination of numbers being created before sending an email, so its not fixed.
Any advice plz?
Thanx

SOLUTION

dqmq

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

John_BAS

ASKER

Thanx a lot,
Its working perfect...

John_BAS

ASKER

The solution was very good

John_BAS

ASKER

Dear dqmq,
I have one bmp file on my computer.
Under the body of email that i send, there is my signature also.
I want to add that bmp file in my signature. I have tried before....but couldn't succed.
Signature is also an html text.
Can you plz help me with a code to put in bmp picture???

Hereby I am attaching code for my signature....
Thanx a lot

GetEmailHandtekeningHTMLDC = "<br>" & rs.Fields("PersNaam")
        GetEmailHandtekeningHTMLDC = GetEmailHandtekeningHTMLDC & "<br>" & "Sales Support"
        GetEmailHandtekeningHTMLDC = GetEmailHandtekeningHTMLDC & "<br><br>" & "BAS Consultancy"
        GetEmailHandtekeningHTMLDC = GetEmailHandtekeningHTMLDC & "<br>" & rs.Fields("AStraat")
        GetEmailHandtekeningHTMLDC = GetEmailHandtekeningHTMLDC & "<br>" & rs.Fields("APostCode") & " " & rs.Fields("APlaats")
        GetEmailHandtekeningHTMLDC = GetEmailHandtekeningHTMLDC & "<br>" & "tel: " & rs.Fields("ATel")
        GetEmailHandtekeningHTMLDC = GetEmailHandtekeningHTMLDC & "<br>" & "fax: " & rs.Fields("AFax")
        GetEmailHandtekeningHTMLDC = GetEmailHandtekeningHTMLDC & "<br>" & "gsm: " & rs.Fields("Telefoon")
        GetEmailHandtekeningHTMLDC = GetEmailHandtekeningHTMLDC & "<br>" & "e-mail: " & rs.Fields("Email")
        GetEmailHandtekeningHTMLDC = GetEmailHandtekeningHTMLDC & "<br>" & "website: " & rs.Fields("AWeb") & "<br><br>"

Open in new window

John_BAS

ASKER

Hello everybody,
Can you plz help me once again with same issue??
Now, when we click on the link "click here to respond yes", a reply message is created with text "Yes".
I am using a complete sentence for a reply message instead of "Yes". I have tried a lot to make some part of sentence as bold, but i couldn't succeed. And the reply messgae is just not reading the code for html formatting.
Is it possible in some way?
Thanx a lot in advance..