Excel VBA Form for Message box and Email

[Jdogg2022]

Hi All,

Hoping someone can help me on this,

I am trying to have a message box populate in my code so that it could execute in the body of an email of more than one line. I can get it working for a single line, but I want to be able to do multiple lines and figure the best way to do this would be to do a user form with a text box.

I am at the point of where I can get the macro to show the form, but I am struggling with getting the user input to be executed into the body of the email

My variable {W_Bodymessage}

Below is my code

Option Explicit

Sub Lettersend()

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim fd As Office.FileDialog
Dim strFile As String
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String ', Title As String
Dim PdfFileTC As String
Dim OutlApp As Object
Dim i2 As Integer
Dim W_Customer As String
Dim W_Email_Address As String
Dim W_Customer_Name As String
Dim W_Excel_Tab As String
Dim W_Month_Rate As String
Dim W_Message As String
Dim W_BodyMessage As String



'Adding Message Dialogue box to Create Subject Header
W_Message = "Enter The Subject header you wish to have to Email Recipient"
W_Message = InputBox(W_Message, "Subject Header")
If W_Message = "" Then
Exit Sub
End If
'Adding Message Dialogue box to Create Text for body of Email
W_BodyMessage = "Enter The Text you wish to put in the body of the email"
'W_BodyMessage = InputBox(W_BodyMessage, "Text you wish to put in the body of the email")

Messagebox.Show



If W_BodyMessage = "" Then
Exit Sub
End If

'Setting up the File Select (for PDF)
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Filters.Add "PDF Files", "*.PDF?", 1
.Title = "Choose an PDF file"
.AllowMultiSelect = False

.InitialFileName = "G:\Transport\FCL Delivery Contacts\Transport Email Notifications\"
If .Show = -1 Then
strFile = .SelectedItems(1)
Else
Exit Sub
End If
End With

'Start Loop
i2 = 2
For i2 = 2 To 1000
Range("AH" & i2).Select
If Range("AH" & i2).Value = "" Then
Exit For
Else
'W_Customer = Range("J" & i2).Value
W_Email_Address = Range("AH" & i2).Value
'W_Customer_Name = Range("B" & i2).Value
'W_Excel_Tab = Range("D" & i2).Value
'W_Month_Rate = Range("E" & i2).Value


' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutlApp.CreateItem(0)
.To = W_Email_Address
.CC = ""
.BCC = ""
.Subject = W_Message
.Body = W_BodyMessage
.Attachments.Add strFile
' Try to send
On Error Resume Next

.Send
'<-- Remove "'" to send

Application.Visible = True
If Err Then
Msgbox "E-mail was not sent", vbExclamation
Else
'MsgBox "E-mail successfully Created", vbInformation
End If
On Error GoTo 0

End With

' Delete PDF file
'Kill PdfFile

' Quit Outlook if it was created by this code
If IsCreated Then
OutlApp.Quit
End If

' Release the memory of object variable
Set OutlApp = Nothing

End If

Next i2
'End With

End Sub