Hello and thank you for your answers in advance.
I am opening a word document using excel-vba and save it under a new name.
This is actually working fine.
But problems occur if the word document with the new name is already opened!
Let’s say there is a button to run the script and the user runs it the second time, and has the created file still opened. The user might change something in excel and now wants to check how the new word document would look like afterwords. He will click the button again.
It will open the template (do all changes) and try to save it, but can’t because it is already opened and it might save this document with the old name (template) instead of a new file. Therefor it will overwrite and destroy the template file (got this several times during testing)!
Therefore I am in need of some proper code and a better Error-Handling. My first thought is to check if the document with the filename already exists. But it does not quite do its job:
Sub CreateWordDocument() Dim TemplName, CurrentLocation, DocumentName, Document As String Dim WordDoc, WordApp, OutApp As Object With table1 TemplName = table1.Range("A1").Value 'Get selected template name CurrentLocation = Application.ActiveWorkbook.Path 'working folder Template = CurrentLocation + "\" + TemplName DocumentName = .Range("A2").Value Document = CurrentLocation + "\" + DocumentName + ".docx" 'Open Word Template On Error Resume Next 'if Word is already running Set WordApp = GetObject("Word.Application") If Err.Number <> 0 Then 'Launch a new instance of Word Err.Clear Set WordApp = CreateObject("Word.Application") WordApp.Visible = True 'Make the application visible to the user End If 'if document is already opened in word than close it 'if its not possible to close it - end application to prevent any damage to the template On Error GoTo notOpen Set WordDoc = WordApp.Documents(DocumentName + ".docx") On Error GoTo closeError WordDoc.Close notOpen: 'Open the template Set WordDoc = WordApp.Documents.Open(Filename:=Template, ReadOnly:=False) 'Open Template 'save with new name WordDoc.SaveAs Document closeError: 'open a message box and tell user to close and run again.
At the current stage it just jumpes from “Set WordDoc = WordApp. …” to notOpened. Any suggestions how to solve this issue?
Add this function:
Public Function FileIsOpen(FullFilePath As String) As Boolean Dim ff As Long On Error Resume Next ff = FreeFile() Open FullFilePath For Input Lock Read As #ff Close ff FileIsOpen = (Err.Number <> 0) On Error GoTo 0 End Function
Then use in your code:
If Not FileIsOpen(DocumentName & ".docx") Then Set WordDoc = WordApp.Documents.Open(Filename:=Template, ReadOnly:=False) Else 'Do something else because the file is already open. End If
The document name must be the full path to the document.
Couple of other things:
Document is a string, and
OutApp is an object. All other variables are
Dim TemplName, CurrentLocation, DocumentName, Document As String Dim WordDoc, WordApp, OutApp As Object
It should be:
Dim TemplName As String, CurrentLocation As String, DocumentName As String, Document As String Dim WordDoc As Object, WordApp As Object, OutApp As Object
VBA generally uses
+ for addition, and
& for concatenation.
DocumentName + ".docx"
would be better written as
DocumentName & ".docx"
Document is a reserved word in
Word. It shouldn’t cause too much problem here as the code is in
Excel, but something to keep in mind.