Send email based on unbound form controls? (1 Viewer)

[Shecky]

I would like the user to be able to send an email based on values he entered into a form. I do not need to store the values as they are not going to be needed later. Will I have to generate a report first?
Ideally I would like to..
1- have user complete the form
2-press "send email"
3-List the form controls as text in an email, one after the other.
4-not save any of the data

Is this feasible?

 

[sxschech]

Couple questions:

Will the receiver (to) email be taken from the form or does the user add it to the email (is it to one person or group or to a predefined recipient?

Does the data to be sent need formatting or can be plain text? If formatted, then would need to use some html.

Depending on answer may have some code that could help.

 

[Shecky]

hi thanks!
1- i will hard code the email address into a value list for the control. It only has 1 or 2 options and will not change often
2- no formatting, just a control as text, line space, next control as text.

Just to let you know in case it helps. We are emailing a freight broker for a rate. The form contains data about the load weight and size etc. The quote request has no value in saving.

Thanks for any help you can offer

 

[Gasman]

I would like the user to be able to send an email based on values he entered into a form. I do not need to store the values as they are not going to be needed later. Will I have to generate a report first?
Ideally I would like to..
1- have user complete the form
2-press "send email"
3-List the form controls as text in an email, one after the other.
4-not save any of the data

Is this feasible?

Yes. I used Outlook automation in the past.
You could have a template email setup and just simply replace place holders with the value of your controls.

 

[sxschech]

Assuming you are using Outlook, here is an example from code I use. The first code section will go in the form in the button click event for your email, so only copy what is between the Sub Subcontractors and End Sub. I think I copied all the necessary parts, if not, then we'll need to troubleshoot. Of course, there could be other issues besides missing code that may cause the code not to work fully such as signature file location if using or variables.

Sub subcontractors()
'Send out email to all subcontractors based on provided email list
'20230309
    Dim stto As String
    Dim stcc As String
    Dim stbcc As String
    Dim stmsg As String
    
    stto = "person@mail.com"
    stcc = "person1@email.com; person2@email.com"
    stbcc = "hiddenperson@mail.com; hiddenperson2@mail.com"
    stmsg = "<p>To all Subs and Suppliers,</p>" & _
            "<p>Please see the letter for your reference and use.</p>"


    Call Outlook_ReplyAll("Submittal Process", "To", stmsg, stto, stcc, stbcc, "S:\Letters\LTR SUB Submittal and Letter Process.pdf", , True, 2)
End Sub

You will delete the emails that are hard coded in there and either change to a new hard coded email or you can turn into variable that refers to the data from your form. If you don't need bcc, then can either change to stbcc = "" or can delete that row altogether
Edit the message and add variables to refer to values from your form as needed
The code example also shows adding an attachment, if not needed, can remove that.


The next code section, put in a module. If you have a signature, in the sigstring, change to your signature file name/location and if you don't need it, change to "". Alternatively, You can put a hard code signature in the stmsg code above.

Public Sub Outlook_ReplyAll(Subj As String, SendType As String, Optional Msg As String, Optional fwdto As String, Optional ccto As String, Optional bcto As String, Optional attachfile As String, Optional dtsent As Date, Optional sentfromshared As Boolean, Optional ImportanceLevel As Integer = 1)
'Reply to All from current message
'http://www.vbaexpress.com/forum/showthread.php?56727-How-To-Reply-To-Most-Recent-E-mail-for-a-Specific-Subject
'20180920
'------------------------
'Needs to be fixed so that replies to all, currently seems to only be able to
'display the existing message then have to manually click the reply to all
'button in outlook
'20180920
'Fixed by reviewing link and saw in post #2 that needed to use the SET statement
'rather than simply using .replyall
'added functionality to create message based on Reply, ReplyAll and Forward
'20181008
'------------------------
'Added optional message
'20181009
'Added "To" so can create a new message
'Added optional AttachFile so can attach
'a file, currently only single file, can
'modify later if need to handle multiple
'attachments
'20181101
'Added optional to send on behalf of the
'shared mailbox
'20190104
'Added optional Importance Level, with Late binding
'use the value.
'Name               Value   Description
'olImportanceHigh   2       Item is marked as high importance.
'olImportanceLow    0       Item is marked as low importance.
'olImportanceNormal 1       Item is marked as medium importance. (DEFAULT)
'https://docs.microsoft.com/en-us/office/vba/api/outlook.olimportance
'20190107
'Put in a loop to allow multiple attachments
'20200917
'Added Read Receipt Requested to Letters Ready for Signature
'https://social.msdn.microsoft.com/Forums/office/en-US/248e71f7-8ba3-485f-8735-80c55c2f001f/capture-ms-outlook-email-delivery-received-and-read-received-with-vba?forum=accessdev
'20211006
'Added optional bcc
'20230309
    Dim olApp As Object                 'Late
    Dim Inbox As Object
    Dim InboxItems As Object
    Dim InboxAttachment As Object
    Dim Mailobject As Object
    Dim InboxReply As Object
    Dim SubjectFilter As String
    Dim stBody As String
    Dim SigString As String
    Dim Signature As String
    Dim flds As Variant
    Dim i As Integer
    
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")      'Outlook Running
    If Err.Number <> 0 Then
        Err.Clear
        Set olApp = CreateObject("Outlook.Application") 'Outlook Not Running
    End If
    
    'Doc Control Inbox
    Set Inbox = olApp.GetNamespace("Mapi").Folders("Inbox")
    
    Set InboxItems = Inbox.Items
    'Set InboxAttachment = Mailobject.Attachment
    
    SubjectFilter = (Subj)  ' THIS IS WHERE YOU PLACE THE EMAIL SUBJECT FOR THE CODE TO FIND
    If Len(Msg) > 0 Then
        'stBody = "The RFIs requested below are now closed, if any were missed, please let me know. " & _
                 "<br><br>Thanks,<br>"
        stBody = Msg
    End If
    If SendType = "To" Then 'Original message
        Set Mailobject = olApp.createitem(0)
        'Change only Mysig.htm to the name of your signature
        SigString = Environ("appdata") & _
                "\Microsoft\Signatures\SignatureFile.htm"
    
        If Dir(SigString) <> "" Then
            Signature = GetBoiler(SigString)
        Else
            Signature = ""
        End If
        
        With Mailobject
            .bodyformat = 3      'Late binding in lieu of olFormatRichText
            .to = fwdto
            .CC = ccto
            .bcc = bcto
            If sentfromshared = True Then
                .SentonBehalfofName = "Shared@mail.com"
            End If
            '-----------------
            'Commented out since seems to go to all recipients and not
            'just the one person that needs it
            '20211006
            'If Subj = "Letters Ready for Signature" Then
            '    .ReadReceiptRequested = True
            '    .OriginatorDeliveryReportRequested = True
            'End If
            '-----------------
            .importance = ImportanceLevel
            .Subject = Subj
            .htmlbody = stBody & "<br>" & Signature
            'Attach file if included and it exists in the location specified
            If Len(attachfile) > 0 Then
                If Dir(attachfile) <> "" Then
                    DoEvents
                    '-------------------------------------------
                    'Put in loop to allow multiple attachments
                    '20200917
                    If InStr(attachfile, ",") > 0 Then
                        flds = Split(attachfile, ",")
                        For i = 1 To UBound(flds)
                            .attachments.Add (flds(i))
                            DoEvents
                        Next
                    Else
                        .attachments.Add (attachfile)
                    End If
                    '-------------------------------------------
                    DoEvents
                Else
                    MsgBox attachfile & " not found.", vbOKOnly + vbInformation, "File Not Found"
                End If
            End If
            '.Send
            .Display  'Use for testing in lieu of .Send
        End With
    ElseIf Not Inbox Is Nothing Then
        For Each Mailobject In InboxItems
            'Debug.Print Mailobject.Subject & " " & SubjectFilter
            If InStr(1, Mailobject.Subject, SubjectFilter) > 0 And InStr(1, Mailobject.senton, Nz(dtsent, "")) > 0 Then
                'Set InboxReply = Mailobject.replyall    'per post number2 use set rather than in the with section
                Select Case SendType
                Case "Reply"
                    Set InboxReply = Mailobject.reply
                Case "Reply All"
                    Set InboxReply = Mailobject.replyall
                Case "Forward"
                    Set InboxReply = Mailobject.Forward
                End Select
                With InboxReply 'Mailobject
                    '.replyall                          'per post number2 use set rather than in the with section
                    If Len(fwdto) > 0 Then
                        .to = fwdto
                    End If
                    .htmlbody = stBody & "<br>" & .htmlbody
                    .Display
                End With
            End If
        Next
    End If
            
Finished:
    Set olApp = Nothing
    Set Inbox = Nothing
    Set InboxItems = Nothing
    Set Mailobject = Nothing
End Sub

Function GetBoiler(ByVal sfile As String) As String
'Dick Kusleika
'http://www.rondebruin.nl/win/s1/outlook/signature.htm
'20160826
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sfile).OpenAsTextStream(1, -2)
    GetBoiler = ts.ReadAll
    ts.Close
End Function

 

[Shecky]

thank you! Let me review all and see if I can get it working on my project.