• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to hide worksheets when file saved as .mht

Hi,

I would like a VBA solution that will hide specified sheets but only when the workbook is saved as a .mht file type. The workbook in question will also be saved as a .xlsm in the first instance and then when published be saved as a .mht

I have found:
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean)
Cancel = True
Worksheets("My Sheet").Visible = xlSheetHidden
ThisWorkbook.Save
End Sub

This doesn't quite work for me as it is not specific enough to my save as requirements.

Any ideas?
 
Last edited by a moderator:
Hi Sam,
I have not solved your problem, but I spent some time thinking about it and my work may help you get closer to a solution.

The problem as I see it is that if you use BeforeSave (as per your example), you cannot capture the new filename or extension and therefore cannot run your check.

If you use AfterSave as per the below:
Code:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    If Success Then
        If ThisWorkbook.FileFormat = 45 Then
            Sheets("test").Visible = xlSheetHidden
            ThisWorkbook.Save
        End If
    End If
End Sub

Then unfortunately this does not work because the file format being saved to in the case you want to detect does not store vb projects and so the code is not there to run after the save.

Note I use the check fileformat = 45 here and didn't compare a section of the filename to a string. This is because the extension of the file being present in thisworkbook.name or thisworkbook.fullname for example depends on environment settings and so it might not always be possible to use as a check.

The final option this leaves as far as I know is to try to replace the whole save process with our own code so that we can capture the filetype:
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim newfilename As String
    On Error GoTo earlyexit
    Select Case MsgBox("Click Yes to Save As or No to just Save.", vbYesNoCancel)
    Case vbYes
        newfilename = InputBox("Please enter new file name and extension. E.G. 'test.mht'")
        If Right(newfilename, 4) = ".mht" Then
            If Sheets("test").Visible = True Then
                Sheets("test").Visible = xlSheetHidden
            End If
            ThisWorkbook.SaveAs (ThisWorkbook.Path & "\" & newfilename)
        End If
    Case vbNo
        ThisWorkbook.Save
    End Select
    Cancel = True
    Exit Sub
earlyexit:
    MsgBox ("Error encountered, file not saved.")
    Cancel = True
End Sub

The issue with this as you may have guessed is that you fall into a recursion problem whereby you continually trigger your own code.

I will continue to think and let you know if I come up with something workable.

Stevie

If this was helpful, please click 'Like' in the bottom right!
 
Hi Sam,
the below seems to work specifically only for the extension you specified, but when doing an input such as 'test.xlsx' it causes an error.
I suspect this is something to do with compatibility with vp project code, but i'm not sure. - I fixed the recursion issue quite simply, I was obviously having a mind blank earlier.

Either way I am posting it because it narrowly solves your query, but there is definitely some improvements to be made - I do not have any more time to spend on it today.

Code:
Private recursionBlocker As Boolean
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim newfilename As String
    On Error GoTo earlyExit
    If recursionBlocker = True Then GoTo recurExit
    recursionBlocker = True
    Select Case MsgBox("Click Yes to Save As or No to just Save.", vbYesNoCancel)
    Case vbYes
        newfilename = InputBox("Please enter new file name and extension. E.G. 'test.mht'")
        If Right(newfilename, 4) = ".mht" Then
            If Sheets("test").Visible = True Then
                Sheets("test").Visible = xlSheetHidden
            End If
        End If
        Application.DisplayAlerts = False
        ThisWorkbook.SaveAs (ThisWorkbook.Path & "\" & newfilename)
        Application.DisplayAlerts = True
    Case vbNo
        ThisWorkbook.Save
    End Select
    recursionBlocker = False
    Cancel = True
    Exit Sub
earlyExit:
    MsgBox ("Error encountered, file not saved.")
    recursionBlocker = False
    Cancel = True
recurExit:
End Sub

Stevie

If this was helpful, please click 'Like' in the bottom right!
 
Back
Top