Forum Discussion

YannDV's avatar
YannDV
Copper Contributor
Nov 23, 2021
Solved

VBA - Sending Active Sheet by email

Hi everyone! 

 

I am struggling with my VBA code, I dont understand why it doesn't work. You have to know that I am not very good with VBA coding, just trying to implement small things for my company. 

 

My goal is to send an active sheet by email to our concerned customer by clicking on a button. On the sheet you can find the customer email address in D5, the object in A2, the filename in G7 and cc in H1. 
Once the button is triggered, a pop up ask if I want to send the sheet or all the workbook. When I select "workbook" the code works fine. The problem is when I select the active sheet, it creates a new workbook with only the active sheet (which is what I want), but struggle to save it and give it the write filename (which should be G7). Actually, excel creates a new workbook called "book" and a number instead of the filename I would want, and doesn't save it. Excel Debug mode says the problem come from this line : 

WB.SaveAs FileName:="e:\" & FileName which I highlighted in red in the code bellow. 

 

 

This is the code (I haven't made it myself, found it from the internet, but doesn't work for me. I tried quite a few things but I really dont understand what's not going on) 

 

This is my error message :

When I launch the macro, as it create and open the new workbook with the active sheet, it is open (but with the name book 1)

 

Can someone please help me ? 


Thanks a lot, whish you a nice day!

 

Sub Button2()
'Variable declaration
'Outlook application
Dim oApp As Object
'Outlook MailItem
Dim oMail As Object
Dim WB As Workbook
Dim WS As Worksheet
Dim FileName As String
Dim SendSheetOnly As Boolean
'Turn off screen updating
Application.ScreenUpdating = False
'Ask the user what to send
Select Case MsgBox( _
Prompt:="Do you want to send the active sheet only ?", _
Buttons:=vbYesNoCancel)
Case vbYes
'Yes, make a copy of the active sheet.
SendSheetOnly = True
ActiveSheet.Copy
Set WB = ActiveWorkbook
'Save without formulas ?
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
'Clear the clipboard
Application.CutCopyMode = False
FileName = Cells(7, "G").Value & ".xls"

'Continue when error occurs
On Error Resume Next
Kill "e:\" & FileName
On Error GoTo 0
WB.SaveAs FileName:="e:\" & FileName
Case vbNo
If Len(ActiveWorkbook.Path) = 0 Then
'File hasn't been saved before
MsgBox "Can't send an unsaved workbook", vbCritical
GoTo exiting
End If
SendSheetOnly = False
Set WB = ActiveWorkbook
Case vbCancel
'olDiscard = 1
oMail.Close SaveMode:=1
GoTo exiting
End Select


Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0) 'olMailItem = 0
With oMail
'User input To property
.To = Range("D5").Value
'User input CC property
.CC = Range("H1").Value
'Hard code Read Receipt Requested property
'.ReadReceiptRequested = True
'User input Read Receipt Requested property
'.ReadReceiptRequested = Range("B3").Value
'User input Subject property
.Subject = Range("A2").Value
'User input Body property
.Body = Range("e5").Value
'Hard code Sensitivity property
.Sensitivity = 3 'olConfidential = 3
'Set attachment
.Attachments.Add WB.FullName
'Hard code importance
''olImportanceHigh = 2
.Importance = 2
'Send directly (remove apostrophe on line below to activate)
'.Send
'Display it
.Display
End With
If SendSheetOnly Then
WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False
End If
exiting:
'Restore screen updating
Application.ScreenUpdating = True
'destroy variables and restore memory
Set oMail = Nothing
Set oApp = Nothing

End Sub

  • YannDV 

    try replacing your whole code with this

     

    Sub Button2()
    'Variable declaration
    'Outlook application
    Dim oApp As Object
    'Outlook MailItem
    Dim oMail As Object
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim FileName As String
    Dim SendSheetOnly As Boolean
    'Turn off screen updating
    Application.ScreenUpdating = False
    'Ask the user what to send
    Select Case MsgBox( _
    Prompt:="Do you want to send the active sheet only ?", _
    Buttons:=vbYesNoCancel)
    Case vbYes
    'Yes, make a copy of the active sheet.
    SendSheetOnly = True
    ActiveSheet.Copy
    Set WB = ActiveWorkbook
    'Save without formulas ?
    Cells.Copy
    Cells.PasteSpecial Paste:=xlPasteValues
    'Clear the clipboard
    Application.CutCopyMode = False
    FileName = ".xls"

    'Continue when error occurs
    On Error Resume Next
    Kill "e:\" & FileName
    On Error GoTo 0
    WB.SaveAs FileName:=Range("G7").value & FileName
    Case vbNo
    If Len(ActiveWorkbook.Path) = 0 Then
    'File hasn't been saved before
    MsgBox "Can't send an unsaved workbook", vbCritical
    GoTo exiting
    End If
    SendSheetOnly = False
    Set WB = ActiveWorkbook
    Case vbCancel
    'olDiscard = 1
    oMail.Close SaveMode:=1
    GoTo exiting
    End Select


    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0) 'olMailItem = 0
    With oMail
    'User input To property
    .To = Range("D5").value
    'User input CC property
    .CC = Range("H1").value
    'Hard code Read Receipt Requested property
    '.ReadReceiptRequested = True
    'User input Read Receipt Requested property
    '.ReadReceiptRequested = Range("B3").Value
    'User input Subject property
    .Subject = Range("A2").value
    'User input Body property
    .Body = Range("e5").value
    'Hard code Sensitivity property
    .Sensitivity = 3 'olConfidential = 3
    'Set attachment
    .Attachments.Add WB.FullName
    'Hard code importance
    ''olImportanceHigh = 2
    .Importance = 2
    'Send directly (remove apostrophe on line below to activate)
    '.Send
    'Display it
    .Display
    End With
    If SendSheetOnly Then
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False
    End If
    exiting:
    'Restore screen updating
    Application.ScreenUpdating = True
    'destroy variables and restore memory
    Set oMail = Nothing
    Set oApp = Nothing

    End Sub

     

8 Replies

  • YannDV 

    Do you really want to save the workbook as an Excel 97-2003 workbook? If so, change the offending line to

     

    WB.SaveAs FileName:="e:\" & FileName, FileFormat:=xlExcel8

    • YannDV's avatar
      YannDV
      Copper Contributor
      Thanks I changed it 🙂

      Unfortunately, same problem still occurs 😞

      I m going to add the error message in my main text, maybe the problem can be point out more easily
  • Josh_Waldner's avatar
    Josh_Waldner
    Copper Contributor

    YannDV 

    this might work for you: try moving this line: Set WB = ActiveWorkbook before your error line when debugging. perhaps to the beginning of the code.

    • YannDV's avatar
      YannDV
      Copper Contributor
      Hi Josh,

      Thanks for your help. Unfortunately, it did not change anything, still get an error at the same line... 😕

Resources