Mystery: Filled Excel sheet is blank when attached to an email

[Godot60]

Hi all,

I'm hoping you can help me solve a mystery. I have a button on a form that sends the sheet as an email attachment once it has been completed. The problem is that the email when received is blank and what had been filled out is no longer there. The code appears below. Any clues? Thanks.

Sub Mail_small_Text_Outlook()If Range("f8").Value = "" Or Range("f10").Value = "" Or Range("a29").Value = "" Or Range("j10").Value = "" Or Range("f12").Value = "" Or Range("f14").Value = "" Or Range("k14").Value = "" Or Range("f16").Value = "" Or Range("k16").Value = "" Or Range("H25").Value = "" Or Range("f18").Value = "" Then
MsgBox "Please complete all required fields"
Exit Sub
End If
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "To be extended: " & Sheet1.Range("j10") & vbNewLine & _
"Department: " & Sheet1.Range("f12") & vbNewLine & _
"Classification: " & Sheet1.Range("f18") & vbNewLine & _
"Extension details: " & Sheet1.Range("f20") & vbNewLine & _
"Requestor: " & Sheet1.Range("f14")
On Error Resume Next
With OutMail
.To = "roco@lsre.edu"
.CC = ""
.BCC = ""
.Subject = "Request for extension: " & Sheet1.Range("j10")
.Body = strbody
.Display
.Attachments.Add ActiveWorkbook.FullName
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[CalcSux78]

Try adding "ActiveWorkbook.Save" before adding the attachment. The problem might be that it is attaching the entire workbook from the last saved point.

 

[Logit]

.
You have 2 .Display commands. I deleted the first one, then edited your macro concerning the .Attachment.Add

Option Explicit


Sub Mail_small_Text_Outlook()
    If Range("f8").Value = "" Or Range("f10").Value = "" Or Range("a29").Value = "" Or Range("j10").Value = "" Or Range("f12").Value = "" Or Range("f14").Value = "" Or Range("k14").Value = "" Or Range("f16").Value = "" Or Range("k16").Value = "" Or Range("H25").Value = "" Or Range("f18").Value = "" Then
        MsgBox "Please complete all required fields"
        Exit Sub
    End If


Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String


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


strbody = "To be extended: " & Sheet1.Range("j10") & vbNewLine & _
"Department: " & Sheet1.Range("f12") & vbNewLine & _
"Classification: " & Sheet1.Range("f18") & vbNewLine & _
"Extension details: " & Sheet1.Range("f20") & vbNewLine & _
"Requestor: " & Sheet1.Range("f14")


On Error Resume Next


    With OutMail
        .To = "mymail@lsre.edu"
        .CC = ""
        .BCC = ""
        .Subject = "Request for extension: " & Sheet1.Range("j10")
        .Body = strbody
        
        '.Attachments.Add ActiveWorkbook.FullName
        .Attachments.Add Application.ActiveWorkbook.FullName
        
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        '.Send 'or use .Display
    .Display
    End With


On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing


End Sub