Create/Update footer after SaveAs in Word VBA - vba

I want to generate an automatic footer when I save a new MS Word file, and update the footer if I SaveAs the file.
The code below used to work well with an old Word. With the latest Word it only works if I press F12 on the keyboard. Any help would be greatly appreciated!
Sub FileSaveAs()
Dialogs(wdDialogFileSaveAs).Show
Dim i As Long
Dim ThisPath As String
Dim pName As String
Dim TextInFooter As String
Dim FullName As String
ThisPath = ActiveDocument.Path
pName = ActiveDocument.Name
FullName = ThisPath & "\" & pName
TextInFooter = "This file was saved in: " & FullName & " on the " & Now
For i = 1 To ActiveDocument.Sections.Count
With ActiveDocument.Sections(i)
.Footers(wdHeaderFooterPrimary).Range.Text = TextInFooter
End With
Next
End Sub

As you noticed, the new version triggers the FileSaveAs only on F12. Not sure if this is bug or a feature.
If it is only important that the document shows the information in print or on open - my suggested workaround:
You could avoid the insertion into the footer on save and insert it using fields, the document already has the information you are inserting. You simply need to make it visible. The footer would be then:
This file was saved as { FILENAME \p } the { SAVEDATE \# "dd.MM.yyyy HH:mm:ss"}
Adjust the Date/Time format as needed. You have to force the update of the fields - this is where the auto macros come into it.
Sub AutoOpen()
' set fields to update before printing (if saved as and printed while open)
Options.UpdateFieldsAtPrint = True
' Update all current fields in just opened document
ActiveDocument.Fields.Update
End Sub
Sub AutoClose()
' update fields when closing
ActiveDocument.Fields.Update
End Sub
The only difference would be, that you have the full path including file name and extension there. Additionally, there might be times, when the file is saved but not yet opened/closed/printed and has also not updated the fields.
In theory, you could insert the footer into the document with the AutoOpen macro as well (activedocument.fields.add).

Related

How to search and replace across multiple word documents in the same folder?

I've tried to use the below code which I found on this conversation How To Search And Replace Across Multiple Files In Word? supplied by Charles Kenyon. However, it doesn't seem to work for me. I've enabled macros on my word and added the below code as a new module in Macros. When I go to replace all, it'll replace the text as per normal, but after doing this, when I open up the other macros enabled word doc, I find that the same text is still in these docs, without being replaced. Am I doing something wrong? Namely, I also wish to add a wildcard entry into my replace all, will the below code work or can someone suggest a better alternative? I have tested the below code with and without wildcard entries to no avail. I've also tried the code on this page in my macros but it also didn't work How to find and replace a text in multiple Word documents using VBAThanks for any help!
Option Explicit
Public Sub BatchReplaceAll()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
PathToUse = "C:\Test\"
'Error handler to handle error generated whenever
'the FindReplace dialog is closed
On Error Resume Next
'Close all open documents before beginning
Documents.Close SaveChanges:=wdPromptToSaveChanges
'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document
FirstLoop = True
'Set the directory and type of file to batch process
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
If FirstLoop Then
'Display dialog on first loop only
Dialogs(wdDialogEditReplace).Show
FirstLoop = False
Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
Else
'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again
With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With
End If
'Close the modified document after saving changes
myDoc.Close SaveChanges:=wdSaveChanges
'Next file in folder
myFile = Dir$()
Wend
End Sub

Closing document after saving it with wdFormatDocument format

I have a longer code and in the final part there is an ActiveX button for saving and closing the file. Also, for efficiency, I've added an vbYesNo command for creating a new document based on the template in use.
The code:
Sub macrosave ()
Dim doc As Document
Dim strDosar As String
Dim Ret As Variant
Set doc = Application.ActiveDocument
strDosar = Range.Paragraphs(1).Range.Text
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then
Documents.Add Template:=ActiveDocument.AttachedTemplate.Path & Application.PathSeparator & ActiveDocument.AttachedTemplate.Name
End If
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument = 0
doc.Close
End Sub
If I click yes, a new document is created, the last one is saved and closed afterwards.
If I click no, the active document is saved, but it is not closed afterwards.
I suspect it has something to do with the file format (wdFormatDocument) because this way it eliminates all VBA codes.
The file format is needed because I want to get rid of all content controls after saving the file.
Why doc.Close is not being executed in the second case and what are my options in order to achieve the purpose?
This argument is invalid:
FileFormat:=wdFormatDocument = 0
Perhaps:
Sub macrosave()
Dim doc As Document, strDosar As String, Ret As Variant
Set doc = ActiveDocument
strDosar = Split(doc.Range.Paragraphs(1).Range.Text, vbCr)(0)
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then Documents.Add Template:=doc.AttachedTemplate.FullName
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument
doc.Close False
End Sub
I believe the problem comes from a disagreement between the file extension - doc and the specified file format wdFormatDocument.
Starting with Word 2007 the default file format (wdFormatDocument) refers to the Word Open XML file format, docx. To save as the doc file format requires using wdFormatDocument97. The reason it may have intermittently worked is because the numerical value of this enumeration is 0.
Try
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument97
Or change the extension to docx
doc.SaveAs "\\server\Public\" & strDosar & ".docx", FileFormat:=wdFormatDocument
However docx will not remove the content controls the next time the document is opened. (The doc format will because content controls were introduced at the same time as the new file format, so they aren't supported in the old format.)
If the additional purpose is " it eliminates all VBA codes" then it would make sense to change the attached template before closing the document to Normal.dotm. This removes the link to the attached template and has the added advantage that the document will "find" its template no matter who opens it, later. (When the attached template is not present it can delay opening by a considerable time under some circumstances.)
doc.AttachedTemplate = NormalTemplate
Note that it will also make things simpler to pick up the file path using the FullName poperty of the template:
Documents.Add Template:=ActiveDocument.AttachedTemplate.FullName

VBA method to tag or mark a closed Excel document as "renamed"

I have a lot of Excel documents in a directory. New files are added to the directory all the time, but they need to be renamed using a specific file name pattern (the procedure RenameFile below does this). To solve this I have to iterate through all excel documents and rename only the documents that haven't been renamed earlier.
The problem is that I can't determine if a file has been renamed already. I have an idea that I should mark/tag the document as "renamed" in some way. Well, it's easy if I open each document and set a Document Property or other hidden variable. But that solution would force me to open each document in the directory to see if the property is defined, and then close it again and move on to next. This is too time consuming...
What I need is a method to tag/mark/flag each renamed document in some way. This tag/mark/flag must be accessible without opening the document. Any ideas?
Sub RenameExcelFiles(InFolder As String)
Dim ExcelFile As String
ExcelFile = Dir(InFolder & "\*.xlsx")
Do While ExcelFile <> ""
If Not ExcelFileHasProperty("Is already renamed") Then
RenameFile ExcelFile ' My own rename function
SetExcelFileProperty "Is already renamed"
End If
' Fetch Next Excel file...
ExcelFile = Dir()
Loop
End Sub
Best case scenario solution (that I can think of) - your excel function could be quite unique - e.g. ending on _renamedYYYYMMMDDHHMMSS.
Then, simply split the filename by _ and check whether it contains the word _renamed*. Like this:
Public Sub TestMe()
Dim name As String
name = "someName_renamed2018FEB02122755"
Dim newName As String
newName = Split(name, "_")(UBound(Split(name, "_")))
If InStr(newName, "renamed") Then
Debug.Print "Document is renamed!"
End If
End Sub

FileSave() Word Macro

I have written a macro which when a file is created and the little save button is clicked the macro is triggered(as it overrides the default FileSave function). The macro extracts information from a table in my document, converts it to a string then cleanses that string of any carriage returns then uses that as the file name. An if statement then runs checking whether a hidden row in the table has a value of 1 and if not then it will set the value to 1 and save the document at the location specified with the new filename.
All of this works great except when I re-open the file to edit it, as my users will do, and click save again it tries to run everything again, completely ignoring my If statements first statement and will add a carriage return to the start of the filename effectively breaking the save function to SharePoint as it has an invalid character in it. If you then click save again it will seemingly run the macro as normal and save it by actually reading the if statement correctly. Am I doing something wrong here?
Here is the code:
Sub FileSave()
Dim strText As String
Dim strClean As String
Dim strFileName As String
Dim strLocation As String
Dim strSavedName As String
Dim strCleanSave As String
strText = ActiveDocument.Tables(1).Rows(1).Cells(2).Range.Text
strClean = Application.CleanString(strText)
strFileName = strClean + "_" + Format(Date, "yyyy-mm-dd")
strLocation = "[My SharePoint Site]"
If ActiveDocument.Tables(1).Rows(1).Cells(3).Range.Text = "1" Then
strSavedName = ActiveDocument.Name
strCleanSave = Application.CleanString(strSavedName)
ActiveDocument.SaveAs FileName:=strSavedName
Exit Sub
Else
ActiveDocument.Tables(1).Rows(1).Cells(3).Range.Text = "1"
ActiveDocument.SaveAs FileName:=strLocation & strFileName & ".docx"
End If
End Sub
Word table cell text ranges are terminated with two hidden chars, a carriage return (ASCII 13) and a bell (ASCII 7). Your IF condition returns false because it is testing the equivalence of "1" and "1" & Chr(13) & Chr(7).
In your case you can limit the test to the first char:
If Left$(ActiveDocument.Tables(1).Rows(1).Cells(3).Range.Text, 1) = "1" Then
More generally you can test the visible cell contents with a Len() - 2.
Hope that helps.

Removing internal link to Word-templates via VBA

I'm trying to create a small VB-application that removes the internal link in Word Documents, to their templates.
I have found this guide
http://word.tips.net/Pages/T001437_Batch_Template_Changes.html
and am trying to modify it, to use with VBA instead of Macro programming inside of Office.
However, I'm getting stuck on how to get the Document.Open to work. Any help is appreciated.
This is supposed to run as a free-standing application, and not runt from within Word.
I'm looking for a way to perform what the Macro does, but not from within Word.
There are two pieces of bad news to give here.
1) A document has to have a template. You cannot remove it, only change it to something else.
2) Changing a template does nothing anyway. See this page.
I am wonder if the problem with the Open method is that you are trying to open ".doc" extension files, not the modern ".docx" extension files. The VBA subroutine you linked to only does ".doc" files. This VBA code does both:
Function StringEndsWith( _
ByVal strValue As String, _
CheckFor As String) As Boolean
Dim sCompare As String
Dim lLen As Long
lLen = Len(CheckFor)
If lLen > Len(strValue) Then Exit Function
sCompare = Right(strValue, lLen)
StringEndsWith = StrComp(sCompare, CheckFor, vbTextCompare) = 0
End Function
Sub ChangeTemplates()
Dim strDocPath As String
Dim strTemplateB As String
Dim strCurDoc As String
Dim docCurDoc As Document
' set document folder path and template strings
strDocPath = "C:\tmp\"
' get first doc - only time need to provide file spec
strCurDoc = Dir(strDocPath & "*.doc*")
' ready to loop (for as long as file found)
Do While strCurDoc <> ""
If (StringEndsWith(strCurDoc, ".doc") Or StringEndsWith(strCurDoc, ".docx")) Then
' open file
Set docCurDoc = Documents.Open(FileName:=strDocPath & strCurDoc)
' change the template back to Normal
docCurDoc.AttachedTemplate = ""
' save and close
docCurDoc.Close wdSaveChanges
End If
' get next file name
strCurDoc = Dir
Loop
MsgBox "Finished"
End Sub
long time between answers but may be useful to others. If you have access to the VBE of the Word document [Alt F11], and you want to remove the reference then go to "Tools/References" [top menu] and deselect it from the list of reference files. I had a similar issue where template no longer existed, but it was still being 'referenced' in the Project window, so I did the above.