VBA to save and email workbook

MissingInAction

New Member
Joined
Sep 20, 2019
Messages
33
Office Version
  1. 365
Platform
  1. Windows
Hi everyone

I created a workbook where managers must review the employee access to our systems. All the data is on my data sheet (User Access Info). Every manager has a sheet with his/her employee's system access information ("sheet 1" in this example). "Sheet 1" makes use of a pivot table so that the manager only see his/her own employees and not others.
I only added the code for one sheet (as an example), since the code is the same for all sheets.

I created a macro that must do the following:
Remove the sensitive personnel information from each sheet
Remove formulas/pivot tables by using the paste as values functions
Remove remove my "user access info" sheet which is the data source for the now deleted pivot tables
Save the changes made
Email the entire workbook to management.

The problem is that it does not save the workbook. Even though the changes mentioned above and the "ActiveWorkbook.Save" code is listed before the "send email" code, it emails the workbook without any changes. I know the code works, since I can see the changes being made on my screen while its flashing between the sheets. The three segments of code works fine on their own (namely removing the above mentioned data, saving and emailing), but when put into one macro, it does not work.
I found the email code online and it worked in other Excel files where I had to send emails.

Here is the code I'm using:
VBA Code:
Sub Send_Form()
    Sheets("Sheet1").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A3:A70").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Cells.EntireColumn.AutoFit
    Range("A1").Select
'
    Sheets("User Access Info").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Selection").Select
    Range("A1").Select
'
    ActiveWorkbook.Save
'Email the workbook
    Dim OutMail As Object
    Dim OutApp As Object
    Dim OutMsg As String

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

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    OutMsg = "Sample Line 1<br />" & _
             "<br />" & _
             "Sample Line 2"
    On Error Resume Next
    With OutMail
        .To = "<list of email addresses>"
        .CC = ""
        .BCC = ""
        .Subject = "<Subject>"
        .HTMLBody = OutMsg
        .Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

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

    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox "Email Sent"
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Thank you in advance.
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,848
.
" The problem is that it does not save the workbook. "

The workbook is saved and attached to the email.

Are you saying you want the workbook saved to a location on your computer for viewing later ? If so,
you need to change the line of code ACTIVEWORKBOOK.SAVE so it includes a path where it should be saved.
 

MissingInAction

New Member
Joined
Sep 20, 2019
Messages
33
Office Version
  1. 365
Platform
  1. Windows
Hi Logit
The workbook is already saved on my pc. I only want to save the changes, then email the file.
 

ChrisFoster

Board Regular
Joined
Jun 21, 2019
Messages
127
Office Version
  1. 365
Platform
  1. Windows
Hi Logit
The workbook is already saved on my pc. I only want to save the changes, then email the file.
For clarity, does it save correctly to your PC but the version sent via email is the unsaved/original copy?
 

MissingInAction

New Member
Joined
Sep 20, 2019
Messages
33
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

For clarity, does it save correctly to your PC but the version sent via email is the unsaved/original copy?
That is correct. If I remove the email portion of the code, the file saves correctly. Re-adding the code then makes Excel email the unsaved version.
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,848
I've tested your existing macro here several times. It functions as desired. The saved version is emailed and the saved version
appears on the computer.

?????
 

MissingInAction

New Member
Joined
Sep 20, 2019
Messages
33
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Then I do not understand. I'm using Office 365 and Windows 10 Enterprise, could that make a difference?
 

MissingInAction

New Member
Joined
Sep 20, 2019
Messages
33
Office Version
  1. 365
Platform
  1. Windows
How can I troubleshoot this to find the problem?

EDIT: The macro code is located in Module 2 in VBA, but the button that is linked to the macro is on the same sheet that gets deleted. I don't think it matters, but I'm grasping at straws here.
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,848
.
Well ... for convenience sake I would place the button on a different sheet ? Unless of course you won't need the Command Button after the sheet is deleted.

But no ... I can't see how having the button on the same sheet that is deleted would cause the issue either. But ... try moving it and see.
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,122,463
Messages
5,596,284
Members
414,051
Latest member
tabecker

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top