Disable Save As but not Save in Word 2010 - vba

I am looking to disable Save As in a Word 2010 file but still allow save. In other words I want users to be able to update the existing file but not create copies. I realize that this is impossible to truly do for people who know workarounds but for the general user I have successfully done this in Excel but am pretty new to word VBA.
When I add the following to a brand new document everything works as intended:
Sub FileSaveAs()
MsgBox "Copies of this file cannot be created. Please save changes in the original document." & _
, , "Copy Cannot be Created"
End Sub
My document has other macros for various command buttons but none of them involve saving the document (under original name or save as). There is also a macro running on open but that is 1 line going to a bookmark. When I try to "save as" in this document I get the message box as intended. When I try to "save" though things get strange: I get the save as dialogue (problem 1). Whether I try to save either under same name or other name the dialogue behaves as it normally would except it doesn't save and the dialogue box opens again automatically essentially creating an endless loop until I hit cancel (problem 2). I also intermittently get a "disk is full" warning pop-up after trying to save which I can dismiss but appears a few minutes later as long as he file is open (perhaps related to autosave?)
Since the macro works in the test file I assumed this strange behavior must be something elsewhere in my code but my document with the other macros saves normally as long as I don't include the save as code above so now I'm totally confused. Before I put up the rest of my code which is lengthy and for the reasons stated above I would not think impact things, I figured I'd ask this:
1. Is there any place other than my other command button macros that could be causing this behavior?
2. Is there a better method people recommend to achieve my ultimate goal of disabling save as but not save?
Thanks in advance for any advice you can provide.

The Word application has a DocumentBeforeSave event. To enable application events I suggest to create a class module by the name of ThisApplication and paste the following code into it.
Option Explicit
Private WithEvents App As Application
Private Sub Class_Initialize()
Set App = Word.Application
End Sub
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, _
SaveAsUI As Boolean, _
Cancel As Boolean)
If SaveAsUI Then
MsgBox "Please always use the ""Save"" command" & vbCr & _
"to save this file.", _
vbExclamation, "SaveAs is not allowed"
Cancel = True
End If
End Sub
Add the following code to your ThisDocument module.
Dim WdApp As ThisApplication
Private Sub Document_Open()
Set WdApp = New ThisApplication
End Sub
You may add the Set App = ... line to your existing Document_Open procedure. After the WdApp variable has been initialised all application events will be received by the ThisApplication class where the DocumentBeforeSave event procedure is programmed not to allow SaveAs.
Of course, this is a blanket refusal for all documents. Therefore you may wish to add code to the procedure to limit the restriction to certain documents only. The proc receives the entire document object with all its properties, including Name, Path, FullName and built-in as well as custom properties. You can identify the files you wish to be affected by any of these.
Note that the WdApp variable will be erased in case of a program crash. If this happens the application events will no longer fire. It may be useful to know that application events occur before document events. This is if you wish to use the application's DocumentOpen event as well as or instead of the document's Document_Open event.

Related

VBA in Outlook is not being applied

I'm suddenly in the position of maintaining a form in Outlook that helps users submit requests properly. Here's the how that goes:
Open the form
Fill in the form
Remove cruft, like signatures, etc
Click "Send"
At this point, a VBA script (Project1 -> Microsoft Outlook Objects -> ThisOutlookSession) should kick in and do a couple of things:
Ask the user if they want to send.
If so, turn their entries on the form into a JSON body suitable for the receiving system and send the email.
It appears that the VBA script is not being called at all. So, a couple of questions:
What conditions determine if the VBA script is called? Is it simply the name, "ThisOutlookSession"?
Is there some very basic thing that I can replace the script with temporarily that makes it very obvious? I'm thinking along the lines of what I do in Python when I'm not sure a condition is being met, so I add something like print('This function was called')
Any other suggestions?
As you can tell, I'm very new to this, so small words are appreciated, and thank you.
I think that you can start from this point with the Application.ItemSend event, that called when user clicks the send button:
' in ThisOutlookSession module
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If Item.Class = olMail Then
If MsgBox("Are you want to send the letter '" & Item.Subject & "'?", vbYesNo) = vbNo Then
Cancel = True 'don't send the original letter
Else
' process the letter as you want
Cancel = True 'debug
End If
End If
End Sub
The command in VBA like print("smth") in Python is Debug.Print "smth" that prints text in Immediate window in VBE

Word Save As Default and Iteration

I have tried many different ways of doing this but I can't find one that works for the application.
I have a MS Word Template that will be used by another team.
This is the criteria I have been given.
The initial file name must be 'PL' & the right most figures of a text control box. It should also say Issue 01.
The user must be able to chose the save location.
If the user then opens the document at a later date and saves it should retain the name and path.
If the user 'saves as' then it should up issue the Issue number.
The closest I can get to this working is this: -
In the top section I have this: -
Private WithEvents App As Word.Application and Dim n as long
Then in the Document New I have: -
Private Sub Document_New()
Set App = Word.Application
n = 0
End Sub
Then for the execution I have done this: -
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
ActiveDocument.SaveAs2 "PL" & Right(ActiveDocument.SelectContentControlsByTitle("Works Order Number").Item(1).Range.Text, 5) & " Issue " & Format(n, "00") & ".docx", wdFormatDocumentDefault
End Sub
However, this saves before the user has chosen a location. It works but the user needs to chose the location. So I tried this, this just does the same thing.
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
If Cancel = False Then
n = n + 1
ActiveDocument.SaveAs2 "PL" & Right(ActiveDocument.SelectContentControlsByTitle("Works Order Number").Item(1).Range.Text, 5) & " Issue " & Format(n, "00") & ".docx", wdFormatDocumentDefault
ElseIf Cancel = True Then
Exit Sub
End If
End Sub
Any suggestions or help would very much be welcomed. I basically just want to suggest the filename which up issues with every save as. But I cant find a way to influence that without physically saving.
Thank you in advance for your time and support.
You can repurpose ribbon controls (Save) to call your event handler first. Moreover, if required, you may cancel the default action in the event handler. See Temporarily Repurpose Commands on the Office Fluent Ribbon for more information. Repurposing ribbon controls give you a big plus - corresponding keyboard shortcuts are handled by your code as well. So, you will be able to intercept keyboard shortcuts by the same code.
In case of Backstage UI you can hide the SaveAs button and add your own. Read more about the Backstage UI in the following articles:
Introduction to the Office 2010 Backstage View for Developers
Customizing the Layout of Columns in the Office 2010 Backstage View
You really need to learn how to use the online documentation for VBA. If you had looked up DocumentBeforeSave you would have learned that Cancel is always False when the event is triggered. If you set it to True in the event handler it cancels the save.
You need to intercept the save before the dialog has been displayed, but the event is only triggered after the dialog. Because the criteria for Save is to use the standard functionality it is only the FileSaveAs you need to intercept.
Prior to the implementation of the Backstage view (the File tab) this could be solved simply by creating a routine named FileSaveAs. You can still do this and it will intercept the keyboard shortcut or clicking the QAT button. But it will not intercept the backstage commands. Only the event can do that without rebuilding the Backstage view, and the event won't work for you...
As far as intercepting the dialog to set the initial file name, that has been covered on SO before, here for example.

How to change default path in save on close prompt?

I'm trying to create a template that automatically changes folder suggested by the save prompt to a specified location. I've managed to get it partially working using the following code (modified from here):
Sub FileSave()
Dim UserSaveDialog As Dialog
Set UserSaveDialog = Dialogs(wdDialogFileSaveAs)
'save changes if doc has been saved previously
If ActiveDocument.Path <> "" Then
ActiveDocument.Save
Exit Sub
End If
With UserSaveDialog
.Name = "C:\Users\david\Downloads"
If .Display Then
UserSaveDialog.Execute
End If
End With
End Sub
Using this code, my macro correctly intercepts the default save behaviour (or Ctrl+S), however it doesn't intercept the save dialog when closing the file. I've tried basically copying this code to a new Sub called Document_BeforeSave, FileExit, FileCloseEx and FileCloseAllEx (yes, I am having difficulty with all the different objects and what they do :) all to no avail.
I'm not sure the same code will even work in this event, but I don't even get any indication that it has failed to work, so it seems I'm using the wrong event.
Turns out I somehow missed AutoClose (MS Docs), which does what I want.

How do I make Outlook purge a folder automatically when anything arrives in it?

I hope it's okay to ask this kind of question. Attempting to write the code myself is completely beyond me at the moment.
I need a macro for Outlook 2007 that will permanently delete all content of the Sent Items folder whenever anything arrives in it. Is it possible? How do I set everything up so that the user doesn't ever have to click anything to run it?
I know I'm asking for a fish, and I'm embarrassed, but I really need the thing...
edit:
I've pasted this into the VBA editor, into a new module:
Public Sub EmptySentEmailFolder()
Dim outApp As Outlook.Application
Dim sentFolder As Outlook.MAPIFolder
Dim item As Object
Dim entryID As String
Set outApp = CreateObject("outlook.application")
Set sentFolder = outApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
For i = sentFolder.Items.Count To 1 Step -1
sentFolder.Items(i).Delete '' Delete from mail folder
Next
Set item = Nothing
Set sentFolder = Nothing
Set outApp = Nothing
End Sub
It's just a slightly modified version of a piece of code I found somewhere on this site deleting Deleted Items. It does delete the Sent Items folder when I run it. Could you please help me modify it in such a way that it deletes Sent Items whenever anything appears in the folder, and in such a way that the user doesn't have to click anything to run it? I need it to be a completely automated process.
edit 2: Please if you think there's a better tool to achieve this than VBA, don't hesitate to edit the tags and comment.
edit 3: I did something that works sometimes, but sometimes it doesn't. And it's ridiculously complicated. I set a rule that ccs every sent email with an attachment to me. Another rule runs the following code, when an email from me arrives.
Sub Del(item As Outlook.MailItem)
Call EmptySentEmailFolder
End Sub
The thing has three behaviors, and I haven't been able to determine what triggers which behavior. Sometimes the thing does purge the Sent Items folder. Sometimes it does nothing. Sometimes the second rule gives the "operation failed" error message.
The idea of acting whenever something comes from my address is non-optimal for reasons that I'll omit for the sake of brevity. I tried to replace it with reports. I made a rule that sends a delivery report whenever I send an email. Then another rule runs the code upon receipt of the report. However, this has just one behavior: it never does anything.
Both ideas are so complicated that anything could go wrong really, and I'm having trouble debugging them. Both are non-optimal solutions too.
Would this be an acceptable solution? Sorry its late but my copy of Outlook was broken.
When you enter the Outlook VB Editor, the Project Explorer will be on the left. Click Ctrl+R if it isn't. It will look something like this:
+ Project1 (VbaProject.OTM)
or
- Project1 (VbaProject.OTM)
+ Microsoft Office Outlook Objects
+ Forms
+ Modules
"Forms" will be missing if you do not have any user forms. It is possible "Modules" is expanded. Click +s as necessary to get "Microsoft Office Outlook Objects" expanded:
- Project1 (VbaProject.OTM)
- Microsoft Office Outlook Objects
ThisOutlookSession
+ Forms
+ Modules
Click ThisOutlookSession. The module area will turn white unless you have already used this code area. This area is like a module but have additional privileges. Copy this code to that area:
Private Sub Application_MAPILogonComplete()
' This event routine is called automatically when a user has completed log in.
Dim sentFolder As Outlook.MAPIFolder
Dim entryID As String
Dim i As Long
Set sentFolder = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
For i = sentFolder.Items.Count To 1 Step -1
sentFolder.Items(i).Delete ' Move to Deleted Items
Next
Set sentFolder = Nothing
End Sub
I have taken your code, tidied it up a little and placed it within an event routine. An event routine is automatically called when the appropriate event occurs. This routine is called when the user has completed their log in. This is not what you requested but it might be an acceptable compromise.
Suggestion 2
I have not tried an ItemAdd event routine on the Sent Items folder before although I have used it with the Inbox. According to my limited testing, deleting the sent item does not interfere with the sending.
This code belongs in "ThisOutlookSession".
Option Explicit
Public WithEvents MyNewItems As Outlook.Items
Private Sub Application_MAPILogonComplete()
Dim NS As NameSpace
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
With NS
Set MyNewItems = NS.GetDefaultFolder(olFolderSentMail).Items
End With
End Sub
Private Sub myNewItems_ItemAdd(ByVal Item As Object)
Debug.Print "--------------------"
Debug.Print "Item added to Sent folder"
Debug.Print "Subject: " & Item.Subject
Item.Delete ' Move to Deleted Items
Debug.Print "Moved to Deleted Items"
End Sub
The Debug.Print statements show you have limited access to the sent item. If you try to access more sensitive properties, you will trigger a warning to the user that a macro is assessing emails.

Word macros not running correctly when opened from PowerPoint action button

I have a Word template (suggestion from) which includes an autonew macro to insert a reference number at a book mark and an action button (Submit)which saves the resulting document with the reference number as part of the file name and closes Word. This works perfectly well when opening the template via Windows Explorer.
We also have a PowerPoint show with action settings hyperlinking to various documents. The link will open the above template OK but does not insert the reference number. Also when the 'submit' button is hit, the file saves as another template with the reference number included.
I am not sure if the issue is Word or PowerPoint-related. The code for the Word template is
Sub AutoNew()
REF = System.PrivateProfileString("L:\Local\Lab\Section - Support Services\Health and Safety\H&S Suggestions\Settings.Txt", _
"MacroSettings", "REF")
If REF = "" Then
REF = 1
Else
REF = REF + 1
End If
System.PrivateProfileString("L:\Local\Lab\Section - Support Services\Health and Safety\H&S Suggestions\Settings.Txt", "MacroSettings", _
"REF") = REF
ActiveDocument.Bookmarks("REF").Range.InsertBefore Format(REF, "000#")
End Sub
Private Sub CommandButton1_Click()
REF = System.PrivateProfileString("L:\Local\Lab\Section - Support Services\Health and Safety\H&S Suggestions\Settings.Txt", _
"MacroSettings", "REF")
ActiveDocument.SaveAs FileName:="L:\Local\Lab\Section - Support Services\Health and Safety\H&S Suggestions\Suggestion " & Format(REF, "000#.doc")
Application.Quit
End Sub
Any help or pointers would be appreciated as if it works I'd like to use for various other templates.
From the description, it's kind of hard to get an accurate idea of what's happening, but it SOUNDS like the the AUTONEW just might not get run in that particular combination.
You could verify this by using some logging or MSGBOX calls to see exactly what macros are being run, when.
Check the docs on Autonew here
http://support.microsoft.com/kb/211659
Sounds like it won't run if the macro is saved in Normal, which doesn't sound like the case here but it's worth noting.
You might also consider using the AutoOpen macro and checking other elements to make sure this is a brand new doc instead of one that's already been saved (like checking the content of the Document.Fullname property).