SaveAs to document changes in documents loops endlessly - vba

I want to force version control in Word documents as our documents are downloaded to work on locally, then re-uploaded.
I had the idea of embedding a macro that runs when a document is closed, presenting an input box, for name/date/summary of changes. This text is added to a hidden bookmark, that can be viewed if there are any version control doubts.
When I share this macro enabled document, saving the file becomes an endless loop. The SaveAs dialog keeps appearing when you click save, and no changes are saved. It works on the system that created the macro.
Reattaching the document template stops this issue, but it would be impractical to expect every user to do this for every document.
Any thoughts on why this save issue occurs, or a more elegant solution?
Private Sub Document_Close()
Dim MyInput As String
Dim oRng As Word.Range
MyInput = InputBox("Please input your name, the date, and a brief summary of your edits.", "Revision Control", "Name: Date: Summary:")
Set oRng = ActiveDocument.Bookmarks("revcontrol").Range
oRng.Text = ActiveDocument.Bookmarks("revcontrol").Range.Text & vbNewLine & MyInput
ActiveDocument.Bookmarks.Add "revcontrol", oRng
oRng.Font.Hidden = True
lbl_Exit:
Exit Sub
End Sub

Related

Printing pdf through automating word with VB net without showing dialog

I've finally encountered a problem, where I didn't already find the answer here or anywhere else on the web:
My program grabs some measurement values from an instrument (I cannot directly control it so I have to wait until the measurement was done by the user and parse the report), calculates some derived values and shall put these values back into the pdf report, which was automatically generated by the instrument control software.
It all works until I come to the line where the printout is started. It always opens the word print dialog instead of silently overwriting my file. I actually don't understand what I am doing wrong when calling PrintOut.
Here is the example code:
Imports Microsoft.Office.Interop
Module Example
Private Sub PrintReport()
Dim intAnswer As Integer
Dim strReportFileName As String = ""
Dim appWord As New Word.Application
Dim wdDoc As Word.Document
dim strPPF as string = "0.5" 'For testing, normally a parameter
dim strFolder as string = "C:\UVVis-Data" 'For testing, normally a parameter
'Find and open the PDF file of the report:
strReportFileName = (From fi As IO.FileInfo In (New IO.DirectoryInfo(strFolder.GetFiles("*.pdf")) Order By fi.LastWriteTime Descending Select fi)(0).FullName 'It will be always the newest file in that folder
appWord.Visible = False 'hide word from the user
wdDoc = appWord.Documents.Open(strReportFileName) 'open the PDF report
'Replace the placeholders which were defined in the report template earlier:
With appWord.Selection.Find
.Text = "#PPF#"
.Replacement.ClearFormatting()
.Replacement.Text = strPPF
.Execute(Replace:=Microsoft.Office.Interop.Word.WdReplace.wdReplaceAll)
End With
'Print out the modified report:
'wdDoc.PrintOut(False, False,, strReportFileName,,,,,,, True) 'this was my first approach
wdDoc.PrintOut(Background:=False, Append:=False, OutputFileName:=strReportFileName, PrintToFile:=True) 'this also doesn't work as intended
'Close the file and restore word to it's normal state:
wdDoc.Close(Microsoft.Office.Interop.Word.WdSaveOptions.wdDoNotSaveChanges)
appWord.Visible = True
appWord.Quit()
End Sub
end Module
Use the Document.ExportAsFixedFormat method which saves a document as PDF or XPS format.
Public Sub ExportAsFixedFormat_Example()
wdDoc.ExportAsFixedFormat pbFixedFormatTypePDF, "pathandfilename.pdf"
End Sub
Thank you for the input.
I found a second problem with my code: I cannot overwrite the original document once it is open in word.
I solved this by first moving the pdf to a temporary folder, opening that temporary file in word and deleting it after word is closed.

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

Word AutoOpen for specific File

Is it possible to build something like AutoOpen but less generic? So I mean a macro, which executes when you open file xyz.docx.
Please, copy the next code in "Normal.dotm" "ThisDocument" code module:
Option Explicit
Const docName = "xyz.docx" 'use here the document name you need
Private Sub Document_Open()
If ActiveDocument.Name = docName Then
MsgBox ActiveDocument.Name & " has been opened..."
End If
End Sub
The Open event is triggered for any document being open.
Here's a sample macro that automatically runs when the document opens. This sample checks whether the user is trying to open a template for editing, then it creates a new document based on the template instead. (Bypass the macro by holding down Shift while you open the file).
This sample only makes sense when placed in a macro-enabled template, but you could also add something like this to a macro-enabled document. The document location would also have to be made a trusted location in Windows.
Sub AutoOpen()
Dim PathTemp$, NameTemp$
If ActiveDocument.Type = wdTypeTemplate Then
NameTemp$ = ActiveDocument.Name
PathTemp$ = ActiveDocument.Path
Documents.Add Template:=PathTemp$ & Application.PathSeparator & NameTemp$
For Each fWindow In Application.Windows
If fWindow.Caption = NameTemp$ Then
fWindow.Close SaveChanges:=wdDoNotSaveChanges
End If
Next fWindow
End If
End Sub

Create/Update footer after SaveAs in Word 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).

Word vba document.readonly status incorrectly returns false

I have an excel project that checks word documents for a changed modify date and, if changed, it opens that document and imports the text from the word form fields into excel.
The routine in excel that opens and imports the word documents is as follows:
Sub CopyFromWord(pFile as String,aFile as string)
Dim wdApp As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
Else 'word is already running
End If
On Error Goto 0
Set wdDoc = wdApp.Documents.Open(Filename:="" & pFile & "", ReadOnly:=True)
wdApp.Visible = False
For Each c In wdDoc.bookmarks
'removed code that copies values from word doc fields to excel sheet
Next c
wdApp.Activedocument.Close SaveChanges:=False
End Sub
The word documents all started out as copies of the same file. There are a few thousand copies of the file, but each located in their own folder with a unique name.
The user finds the folder they need and opens the word document within it. It bring up a userform and then populates formfields in the document with the input to the userform. A command button then saves and exits the form.
Because the welcome message/userform loads automatically upon the document opening, I added the following code into the open event for the document:
Sub Document_Open()
If ThisDocument.ReadOnly = True then Exit Sub
msgbox "Welcome " & Environ$("Username") & ". Click OK to begin."
Userform1.show
End sub
This ensures when the excel project loops through all the files, if it finds one has changed, it needs to open the file (read only) so it can import the data without being interrupted with a userform / welcome message, close it, and carry on searching looping all files checking for changed modify-dates.
It should run constantly, however, about 20% of the time, a document will be opened read only by the excel code, but the welcome messagebox in the word document will show, indicating thisdocument.readonly incorrectly returned false.
If I debug the word document in this scenario, and do
? thisdocument.readonly
I get a "false" result. However, even the title bar of the word document ends with " (Read-Only)" so it has clearly been opened read-only, thus readonly should return True.
It is not specific to any documents, if I try to repeat opening them it seems to work the next time round (in that it correctly registers a read-only and exits the sub before the messagebox code). I cant find any kind of pattern and can't find any info online, I've been searching this for weeks!
May not be considered the answer, but following Tim William's suggestion, I managed to put together this which completely solves my problem. I struggled at first because I was trying to set the property too early. Complete code is as follows:
Sub CopyFromWord(pFile as String)
Dim wdApp As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
Else 'word is already running
End If
On Error Goto 0
'save current setting
secAutomation = wrdApp.Application.AutomationSecurity
'set Word to disable macros when a document is opened via vb:
wrdApp.Application.AutomationSecurity = msoAutomationSecurityForceDisable
'(without using wrdApp prefix it would only apply to the code's App i.e. Excel)
Set wdDoc = wdApp.Documents.Open(Filename:="" & pFile & "", ReadOnly:=True)
wdApp.Visible = False
For Each c In wdDoc.bookmarks
'removed code that copies values from word doc fields to excel sheet
Next c
'restore original setting before closing
wrdApp.Application.AutomationSecurity = secAutomation
wdApp.Activedocument.Close SaveChanges:=False
End Sub
Many thanks to Tim Williams for the link, and the guy who provided the code within the content of that link. This was such a help and is most appreciated.