VBA to save and email workbook

MissingInAction

New Member
Joined
Sep 20, 2019
Messages
18
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.
 

MissingInAction

New Member
Joined
Sep 20, 2019
Messages
18
So it did make a difference. I have no idea how or why though, but my file is now working as intended. Now I just to find a place to hide the button haha (or run the macro directly from the macro screen).
Thank you for the help Logit.
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,708
.
You can add a line of code that deletes the button, after the sheet is deleted. No need to hide it.

Glad you have a working project !
 

ChrisFoster

Board Regular
Joined
Jun 21, 2019
Messages
127
Office Version
  1. 365
Platform
  1. Windows
The button will just be a link to run the macro, so that shouldn't technically make any difference.
 

ChrisFoster

Board Regular
Joined
Jun 21, 2019
Messages
127
Office Version
  1. 365
Platform
  1. Windows
Why do you need a button? Can you not just use a shortcut? so Ctrl + u for instance to run the code.
 

Watch MrExcel Video

Forum statistics

Threads
1,113,909
Messages
5,544,994
Members
410,647
Latest member
LegenDSlayeR
Top