VBA Script for a Control - Send Email

[MadAlice22]

Good Morning, I am looking for some support with a template I am creating (see below). I have two controls - one to use to send the information in an email, and the other to clear the form. I have used a Macro for the clear form control, and that is working fine. I am looking for assistance with the VBA script for the send request control, as I am not confident with this!

<strike></strike>I would like it to do the following things if possible:​

1. Take the data between B9 & K27 and paste it into the body of the email - I don't want to send the whole file as an attachment
2. Only send the email if the fields F11, F13, F17, F19, F21, F23 & F25 have data in them, if not then display an error of some sort

This is the code I have so far for setting the email up:

​

Private Sub CommandButton1_Click()
On Error GoTo ErrHandler

' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")

' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = "Danielle.short@cbre.com"
.CC = ""
.subject = "PO Request - CA001223-2 : Extra Works"
.body = "Please see attached new PO request"
.Display ' DISPLAY MESSAGE.
End With

' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing

ErrHandler:
'
End Sub

Any help would be really appreciated!! I have seen a script for this before but can't for the life of me remember it!!

​

<strike></strike>
Thank you <strike></strike>
​

 

[starl]

I didn't see an example of how you wanted the cells to be used in the body. Code not tested.

Private Sub CommandButton1_Click()
Dim cellAddress As String, errMessage As String
Dim i As Integer


On Error GoTo ErrHandler


'Check cell values for entries
For i = 1 To 7 'loop through all the cell addresses listed, update count if needed
    cellAddress = Choose(i, "F11", "F13", "F17", "F19", "F21", "F23", "F25") 'list addn'l addresses here
    If Len(Trim(Range(cellAddress).Value)) = 0 Then
        errMessage = errMessage & cellAddress & ","
    End If
End If
If Len(errMessage) > 0 Then
    errMessage = Left(errMessage, Len(errMessage) - 1)
    errMessage = "Empty field(s):" & errMessage
    GoTo ErrHandler
End If


' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")


' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
    .To = "Danielle.short@cbre.com"
    .CC = ""
    .Subject = "PO Request - CA001223-2 : Extra Works"
    .body = "Please see attached new PO request" & Range("B9").Value & " more text " & Range("K27").Value
    .Display        ' DISPLAY MESSAGE.
End With


' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing


ErrHandler:
If Len(errMessage) > 0 Then
    MsgBox errMessage
End If
End Sub

 

[MadAlice22]

Hello,

Thank you for your help with this!

I was hoping to take the section between B9:K27 and copy it into the body of the email - does this make sense?

The code didn't work initially but after some tweaking (as below) it now does, but opens 8 email windows - see below code:

Private Sub CommandButton1_Click()
Dim cellAddress As String, errMessage As String
Dim i As Integer

On Error GoTo ErrHandler

'Check cell values for entries
For i = 1 To 7 'loop through all the cell addresses listed, update count if needed
cellAddress = Choose(i, "F11", "F13", "F17", "F19", "F21", "F23", "F25") 'list addn'l addresses here
If Len(Trim(Range(cellAddress).Value)) = 0 Then
errMessage = errMessage & cellAddress & ","
End If
If Len(errMessage) > 0 Then
errMessage = Left(errMessage, Len(errMessage) - 1)
errMessage = "Empty field(s):" & errMessage
GoTo ErrHandler
End If

' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")

' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = "Danielle.short@cbre.com"
.CC = ""
.subject = "PO Request - CA001223-2 : Extra Works"
.body = "Please see attached new PO request" & Range("B9").Value & " more text " & Range("K27").Value
.Display ' DISPLAY MESSAGE.
End With

' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing

ErrHandler:
If Len(errMessage) > 0 Then
MsgBox errMessage
End If
Next
End Sub

I tried amending the code to the below (in my naivety!) but I get a runtime error 13 Type Mismatch and am unsure how to fix this . .

' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = "Danielle.short@cbre.com"
.CC = ""
.subject = "PO Request - CA001223-2 : Extra Works"
.body = "Please see attached new PO request" & Range("B9:K27").Value
.Display ' DISPLAY MESSAGE.
End With

Is it possible to copy this section (once filled in) into the body of the email? The error message for unfilled boxes is working great

Let me know your thoughts and thank you again
​

 

[starl]

1. You get multiple email windows opened because .Display shows the windows. Use .Send to actually send them without the chance to review.
2. You get an error in your modification because you're trying to place multiple cells (a range, an array) into a string - a word. You can't do that. The range would require html and since you also have additional text in your email... though I suppose you could put that text in a cell instead. Doesn't make for a pretty email, but it would be easier to code.

Here's code that shows how to include a range in an email. It's pretty involved. I'd recommend putting your "Please see..." in A1, then placing your range below that in the new workbook (used to create the html code you'll need for the email)
https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

 

[MadAlice22]

Thank you so much really appreciate your help with this query!