Autofill Read only Excel 2010 xlsm SaveAs file name box - vba

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim saveIt As Boolean
If ThisWorkbook.Name = "Test.xlsm" Then
Sheets("Sheet1").Select
If Not IsEmpty(A1.Value) Then
MsgBox "This workbook is 'read only' Please rename this workbook."
strName = "Please enter a new file name."
ThisPAth = Application.ActiveWorkbook.Path
ThisFile = Range("B1").Value
ActiveWorkbook.SaveAs Filename:=ThisPath & ThisFile & ".xlsm", FileFormat:=52, CreateBackup:=False
Else
MsgBox "Cancelled."
End If
End If
End Sub
I have a password protected workbook (Test.xlsm" that is strictly for data entry. When the user opens the workbook as read only, enters the data, and then exits the workbook/template, I want the SaveAs dialog box that automatically pops up to have the contents of A1 of Sheet1 to be the "Suggested" file name that is autofilled in the SaveAs box.
I thought if I snagged the BeforeSave function that I could declare this path/filename but alas, it does not work. The autofill box displays "Copy of Test.xlsm". I do not even think it sees the above code.
How can I accomplish autofilling this box with the desired name. Thanks.
------------Update------------------
Rewrote code to below but it still is not snagging the default dialog box on save. Maybe I am misunderstanding the Workbook_BeforeSave function. I thought it was automatically called whenever the file is getting saved. I never want the user to save the file with the name Test.xltm (I changed file to a template to see if that made a difference) but to suggest the user rename file to the value in B1 for standardization reasons. The code is not getting called automatically. I was able to get similar code to work if I call it by executing a macro from the quick access toolbar for example, but cannot seem to get it to execute automatically whenever the user selects "Close", "Save" or "Save As" from the "File" pull down menu.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim saveDialog As FileDialog
Debug.Print "Hello"
Set saveDialog = Application.FileDialog(msoFileDialogSaveAs)
If ThisWorkbook.Name = "Test.xltm" Then
Application.EnableEvents = False
Debug.Print "Save as"
Set saveDialog = Application.FileDialog(msoFileDialogSaveAs)
With saveDialog
.InitialFileName = "foo.xlsm"
.Show
End With
Application.EnableEvents = True
Else
Debug.Print "Cancel"
End If
End Sub
The template is password protected and opened as read only by user so SaveAs dialog box should always open upon exit/save/save as. Correct? And shouldn't the Workbook_BeforeSave always get called under this circumstance?

Example:
Sub saveDialogTest()
Dim saveDialog As FileDialog
Set saveDialog = Application.FileDialog(msoFileDialogSaveAs)
With saveDialog
.InitialFileName = "Foo.xlsx"
.Show
End With
End Sub
If you use the FileDialog like this, it will allow you to change the suggested file name.

Related

Create a backup of a document

My macro should make a backup (in a specified path) of a file that is currently being saved, a procedure that is often discussed since it is a feature that Word lacks.
Private Sub Document_Close()
Dim blank As Range
For Each blank In ActiveDocument.StoryRanges
If Len(blank.Text) = 1 Then Exit Sub
Next
End Sub
Sub FileSave()
Dim BackupPath As String, objF As Object, retVal As Long, Rslt
BackupPath = "C:\Users\" & Environ("UserName") & "\Documents\BackupWord\"
With ActiveDocument
If .Path = "" Then: If Application.Dialogs(wdDialogFileSaveAs).Show <> -1 Then Exit Sub
If Len(Trim(.Range.Text)) = 1 Then Exit Sub
.Save
If Dir(BackupPath, vbDirectory) = "" Then
MkDir BackupPath
MsgBox "Backup folder has been created.", vbInformation
End If
If .Path & "\" = BackupPath Then
MsgBox "WARNING! Backup folder is the same as the source folder", vbExclamation
Exit Sub
End If
Set objF = CreateObject("Scripting.FileSystemObject")
retVal = -1
On Error Resume Next
retVal = objF.CopyFile(.FullName, BackupPath & .Name, True)
On Error GoTo 0
Set objF = Nothing
If retVal <> 0 Then MsgBox "Backup has not been copied to folder " BackupPath, vbExclamation
End With
End Sub
I will describe what the macro currently does.
FileSave procedure is intercepted.
The macro checks if an active document is saved. If it is, no extra action is required and the macro closes.
If an active document in not saved, the usual "Save As" dialogue appears. If the user chooses to not save the file then the macro closes.
If document is not saved, the macros saves it.
The macro looks for a backup folder. If it is not found, the macro creates it and shows a message box.
Then the macro checks if the source folder is the same as the backup folder. If they are the same, the macro shows a message and closes.
The active (current) document is copied to the backup folder. If it fails, a message box is displayed.
My macros fail to make a backup on two occasions.
When I open Word (no document opened, just blank page), modify it
and choose to close Word, a SaveAs dialog is shown. Then I choose to
save and the document is saved correctly but a backup copy is not
created.
When a document exists on, say, harddrive, pendrive etc.
and I will modify it and choose to close Word a SaveAs dialog is shown.
Then I choose to save and the document is saved correctly but a
backup copy is not created.
You would need a class, i believe at addin level to track all sheets, something like...
Option Explicit
Private WithEvents wd As Word.Application
Public Sub initialise(w As Word.Application)
Set wd = w
End Sub
Private Sub wd_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
' Your code here
End Sub
In your addin (.dotm) file you'd have the following
Option Explicit
Public c As clsCustomWord
Sub AutoExec()
Set c = New clsCustomWord
c.initialise Application
End Sub
Hope this helps

How to disable Auto_Open after first save

When opening up a template a macro that is Auto_Open runs this code:
Sub Auto_Open()
UserForm.Show
End Sub
This then brings up a userform that says please save as and a Ok command button.
When Ok is clicked it has the this code.
Private Sub SaveAs_Click()
Dim bFileSaveAs As Boolean
bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
If Not bFileSaveAs Then MsgBox "User cancelled", vbCritical
Unload Me
End Sub
Problem is after the Auto_Open is ran for the first SaveAs i want it to never run again. Because I want to be able to open it later with out the Userform popping up. So how do I disable the Auto_Open once its run and then save it disabled
I cant disable all macros because there are others in the workbook that still need to work.
Thanks
You have to use the Workbook.SaveAs method MSDN Found Here after you get the SaveAsFilename...
As for deleting a sub after it runs (I'd do this before saving) See here... You'll need your Auto Open Sub in a different module so you can delete the module before saving.
Private Sub SaveAs_Click()
Dim x As Object
Set x = Application.VBE.ActiveVBProject.VBComponents
x.Remove VBComponent:=x.Item("TestModule") 'Where TestModule is the module that holds the Auto Open script
Set NewBook = Workbooks.Add
Do
fName = Application.GetSaveAsFilename
Loop Until fName <> False
NewBook.SaveAs Filename:=fName
fName = False
Unload Me
End Sub
Exit auto_open if file name without specific wording.
For example: If file name is not starting from "N", auto_open will be exit.
Sub auto_open()
VBA_CODE = ActiveWorkbook.Name
If Left(VBA_CODE, 1) <> "N" Then Exit Sub

How to get Excel to require user to allow macro else cannot open workbook?

I have a macro in my Excel file that is meant to determine whether a user can open it or not. However, it seems like, depending on the settings of the user's machine, Excel by default disables the macro. This ended up opening and revealing the contents in the xls file.
How can I make sure that the user has to accept running the macro or Excel will close the workbook?
UPDATED the code as it was not doing exactly what it was meant to...
This is pretty much the only way you can do this WITH a macro (thanks to #OlleSjögren for the insight :p)
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Current As Worksheet
Worksheets.Add(Before:=Worksheets(1)).Name = "Protection"
Worksheets("Protection").Cells(1, 1) = "Please activate macros to view this workbook."
For Each Current In Worksheets
If Current.Name <> "Protection" Then
Current.Visible = xlSheetVeryHidden
End If
Next Current
End Sub
Private Sub Workbook_Open()
Dim Current As Worksheet
For Each Current In Worksheets
Current.Visible = xlSheetVisible
Next Current
Application.DisplayAlerts = False
Worksheets("Protection").Delete
Application.DisplayAlerts = True
End Sub
The property xlSheetVeryHidden means that it cannot be made visible through the UI (VBA code only can change it).
I think you can't do it. But we can make a workaround.
First of all you need to hide all your worksheet and prevent user to unhide it. Link. Following the link you will see that you can make a sheet veryHidden. As the link shows, you need to add a password to vba code too.
Then you can to create a macro that adds an InputBox with password
Sub CheckPassword()
Dim password As String
password = InputBox("Enter the password") 'You can use a Form with Textbox [PasswordChar] to put ****
If password = "myPass" Then
Sheets(3).Visible = xlSheetVisible
Sheets(3).Select
End If
End Sub
Finally you can attach a sub in the close event.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets(3).Visible = xlSheetVeryHidden
End Sub

Close Save As window without saving

I want to save a Word document according to this condition:
IF 'check something' Then:
Dim myDialog As Object
Set myDialog = Dialogs(wdDialogFileSaveAs)
myDialog.Display
myDialog.Execute
End if
Continue doing all the rest...
If the Save As window opens and the user closes it without saving by clicking the (X) on the upper corner the sub continues to run as if the user decides to save the file.
How can I exit the sub if the user closes the Save As window?
Try this. I have used Excel VBA, but you can easily change it for Word.
Sub Test()
myDialog = False
myDialog = Application.Dialogs(xlDialogSaveAs).Show
If myDialog = False Then
MsgBox "Don't Execute"
Exit Sub
Else
MsgBox "Execute Stuff"
End If
MsgBox "After If Condition"
End Sub

How to disable the MS Word "macro-free document" warning with code?

I have an application that dynamically insert VBA code to help building a MS word document with proper bookmarks. The VBA code doesn't need to be saved with the document itself.
When saving the document, the following warning (unfortunately I can't post an image yet) will pop up that confuses the end users of the application. Is there a way to disable this within the DocumentBeforeSave event?
**
The following cannot be saved in a macro-free document: VBA project To
save a file with these features, click No to return to the Save As
dialog, and then choose a macro-enabled file type in the File Type
drop-down. Continue saving as a macro-free document?
buttons: [Yes][No][Help]
**
One idea is to change the document's SaveFormat to an older format in order to prevent this warning from popping up. But I'm not sure if this change will affect how the document behaves going forward and if it's even possible to modify this property within the DocumentBeforeSave event (the property is a READONLY property).
Thanks in advance for any help on this topic.
The following code will open a word (assuming c:\work\test.docx exist, which can be just a blank word doc). If you hit the Save button on the word doc, the warning message will show up. BTW, I'm using Office 2010.
<TestMethod()>
Public Sub testWord()
Dim wApp As New Word.Application()
Dim myDoc As Word.Document
Dim DataCodeModule As Object = Nothing
myDoc = wApp.Documents.Open("C:\Work\test.docx")
DataCodeModule = myDoc.VBProject.VBComponents(0).CodeModule
With DataCodeModule
.InsertLines(1, "Option Explicit")
.InsertLines(2, "Sub TestCode()")
.InsertLines(3, "Selection.InsertAfter ""test""")
.InsertLines(4, "End Sub")
End With
wApp.Visible = True
myDoc.Activate()
End Sub
And once the DocumentBeforeSave is hooked up, I was hoping the following code would disable the warning. Maybe the DisplayAlerts need to be set as soon as the document is opened?
Public Sub App_DocumentBeforeSave(ByVal doc As Object, ByRef saveAsUI As Boolean, ByRef cancel As Boolean) Handles _officeHelper.DocumentBeforeSave
Dim WordApp As Object = this.WordApp()
'WordApp.DisplayAlerts = False
WordApp.DisplayAlerts = 0
End Sub
Like this?
Application.DisplayAlerts = wdAlertsNone
'~~> Your Save Code
Application.DisplayAlerts = wdAlertsAll
FOLLOWUP
You are doing it in vb.net. I don't have access to VB.net at the moment but this example below will set you on the right path
Open Word and insert a module and then paste this code
Option Explicit
Dim MyClass As New Class1
Sub Sample()
Set MyClass.App = Word.Application
End Sub
Now insert a Class Module and paste this code
Public WithEvents App As Word.Application
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, _
SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = wdAlertsNone
ActiveDocument.Save
Application.DisplayAlerts = wdAlertsAll
End Sub
Now if you press the save button, you will notice that you won't get that alert any more. :)
Hope you can adapt it as required :)
I simply done this code . It will prompt you to save and also help you in attaching it to email.
It worked for me.
Please try. I gave a command button on top of the sheet.
Thanks
Private Sub CommandButton1_Click()
Dim whatfolder, whatfile As String
whatfolder = InputBox("Type folder name.. Don't type which drive")
whatfile = InputBox("Type file name you want to give")
ChangeFileOpenDirectory "C:\" & whatfolder
Application.DisplayAlerts = wdAlertsNone
ActiveDocument.SaveAs FileName:=whatfile & ".docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
Application.DisplayAlerts = wdAlertsNone
ActiveDocument.SendMail
End Sub