Macro Button Sending Blank File

[Wookiee_]

Hi, I built a simple form with VBA that auto sends an email of the form when clicked. The problem is the form is sending a blank sheet, rather than a populated one and I have no idea why. Any ideas? Code is below.

Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Body content" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "person2"
.CC = "person1"
.BCC = ""
.Subject = "RTO " & Range("D6 ") & " " & Range("D10 ") & " " & Range("D11")
.Body = "Hello," & " " & Range("D2") & ", please repond to all with confirmed order number, load date, and time."
.Attachments.Add ActiveWorkbook.FullName
.Send 'or use .Display
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[Georgiboy]

Has the workbook you are running the code from been saved somewhere?

If not then FullName will only return the name of the workbook and not the file path as it will not have one.

 

[Wookiee_]

Yes, I've saved it to my desktop in the template form (blank). So to send it populated the user will have to save a local copy, then re-open it, then click the button to send the completed file? Is there way to send the completed form without saving it locally?

 

[Georgiboy]

An example below of saving a temp copy of a workbook - mail it - delete it.
Original code from Ron de Bruin:

Sub Mail_workbook_Outlook()
    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb1 = ActiveWorkbook

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = ".xlsx"
    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "person2"
        .CC = "person1"
        .BCC = ""
        .Subject = "RTO " & Range("D6 ") & " " & Range("D10 ") & " " & Range("D11")
        .Body = "Hello," & " " & Range("D2") & ", please repond to all with confirmed order number, load date, and time."
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        .Display
    End With
    On Error GoTo 0

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub