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
Related
I got a VBA project from colleague who is retired.
I have to change a function:
Documents.Add Template:= _
"c:\word\Link.dot", _
NewTemplate:=False, DocumentType:=0
Here a new document (another Word file) is created with a template.
This template also relates data from another project "Common".
Basically, Documents.Add Template:= _"c:\word\Link.dot"
in Link.dot the Document_Open() is executed and the Common project is initialized.
Private Sub Document_Open()
Common.Initialize
End Sub
I don't want a second document opened by Documents.add, it should use the already active document.
I tried these two variants:
#1
Dim oDoc As Document
Set oDoc = ActiveDocument
oDoc.AttachedTemplate = "c:\word\Link.dot"
#2
ActiveDocument.AttachedTemplate = "c:\word\Link.dot"
Nothing happens to both of them, even no Runtime Error. I think it's because Document_Open() wasn't executed.
Document_Open() responds to the Open event. As you are not opening a document when attaching the template it will not execute.
You can execute the code directly though.
ActiveDocument.AttachedTemplate = "c:\word\Link.dot"
Common.Initialize
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
I'm trying to add a few custom document properties to a folder of word documents.
I know that the loop itself works fine, because I used the same loop with different code to modify and then update pre-existing custom document properties.
The code to add custom document properties also works, I tested it by running it in it's own macro for a single document, which worked fine.
Since the loop works and the code within the loop also works, I just can't figure out what's wrong with it.
Here's the code:
Sub add_custom_docproperties()
Dim file
Dim path As String
Dim filepath As Variant
filepath = InputBox("Please enter the filepath for the files you want to
update.", "Input Filepath", "Copy filepath here...")
Select Case StrPtr(response)
Case 0
endednotification = MsgBox("The macro has been ended.", , "Notification")
Exit Sub
Case Else
End Select
path = filepath & "\"
file = Dir(path & "*.*")
'Application.ScreenUpdating = False
Do While file <> ""
Documents.Open FileName:=path & file
Check = MsgBox(path & file, , "Check")
ActiveDocument.CustomDocumentProperties.Add Name:="firstdocprop",
_LinkToContent:=False, Type:=msoPropertyTypeString, Value:="The First One"
ActiveDocument.CustomDocumentProperties.Add Name:="seconddocprop",
_LinkToContent:=False, Type:=msoPropertyTypeString, Value:="Second"
ActiveDocument.CustomDocumentProperties.Add Name:="thirddocprop",
_LinkToContent:=False, Type:=msoPropertyTypeString, Value:="Third"
'original example from:
'https://msdn.microsoft.com/en-us/vba/office-shared-vba
/articles/documentproperties-add-method-office
ActiveDocument.Save
ActiveDocument.Close
'set file to next in Dir
file = Dir()
Loop
'Application.ScreenUpdating = True
MsgBox "The macro is complete."
End Sub
As you can see I have a comment there with the first example I tried from msdn, which I modified.
Thanks in advance for any help, even if you could just point me to a resource explaining where I've gone wrong or something like that.
Word does not recognise the changes to the CustomDocumentProperties as being sufficiently important to actually save the document when you execute the Save command - unless you had made other changes it just decides to ignore the Save.
You can force a save by telling Word that the document has not been saved since it was last changed:
ActiveDocument.Saved = False
ActiveDocument.Save
ActiveDocument.Close
I would like to export/ maintain/ manage a text file backup of modules in my personal macro workbook personal.xlsb using VBA.
I cannot find an object library which refers to the modules themselves on msdn. Could someone point me in the right direction on this please?
Using Excel 2013.
You need to add Visual Basic for Application Extensibility X.X reference; or:
Sub load_reference_1()
ThisWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 3
end sub
Sub Load_reference_2()
ThisWorkbook.VBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
end sub
Example:
Sub Macromodule_copy1()
ThisWorkbook.VBProject.VBComponents("Macroos").Export "E:\Macroos.bas"
With Workbooks.Add
.VBProject.VBComponents.Import "E:\Macroos.bas"
End With
End Sub
Further examples and source: Snb-Vba -awesome examples!-
I do exactly this, with my personal.xlsb and also with other macro workbooks.
I save the text files into a "VBA" subdirectory and put them into version control to keep track of the changes.
I was inspired by Mass importing modules & references in VBA which references https://www.rondebruin.nl/win/s9/win002.htm
I have a module called WriteBas containing this code:
Attribute VB_Name = "WriteBas"
Option Explicit
Sub WriteAllBas()
' Write all VBA modules as .bas files to the directory of ThisWorkbook.
' Implemented to make version control work smoothly for identifying changes.
' Designed to be called every time this workbook is saved,
' if code has changed, then will show up as a diff
' if code has not changed, then file will be same (no diff) with new date.
' Following https://stackoverflow.com/questions/55956116/mass-importing-modules-references-in-vba
' which references https://www.rondebruin.nl/win/s9/win002.htm
Dim cmp As VBComponent, cmo As CodeModule
Dim fn As Integer, outName As String
Dim sLine As String, nLine As Long
Dim dirExport As String, outExt As String
Dim fileExport As String
On Error GoTo MustTrustVBAProject
Set cmp = ThisWorkbook.VBProject.VBComponents(1)
On Error GoTo 0
dirExport = ThisWorkbook.Path + Application.PathSeparator + "VBA" + Application.PathSeparator
For Each cmp In ThisWorkbook.VBProject.VBComponents
Select Case cmp.Type
Case vbext_ct_ClassModule:
outExt = ".cls"
Case vbext_ct_MSForm
outExt = ".frm"
Case vbext_ct_StdModule
outExt = ".bas"
Case vbext_ct_Document
Set cmo = cmp.CodeModule
If Not cmo Is Nothing Then
If cmo.CountOfLines = cmo.CountOfDeclarationLines Then ' Ordinary worksheet or Workbook, no code
outExt = ""
Else ' It's a Worksheet or Workbook but has code, export it
outExt = ".cls"
End If
End If ' cmo Is Nothing
Case Else
Stop ' Debug it
End Select
If outExt <> "" Then
fileExport = dirExport + cmp.name + outExt
If Dir(fileExport) <> "" Then Kill fileExport ' From Office 365, Export method does not overwrite existing file
cmp.Export fileExport
End If
Next cmp
Exit Sub
MustTrustVBAProject:
MsgBox "Must trust VB Project in Options, Trust Center, Trust Center Settings ...", vbCritical + vbOKOnly, "WriteAllBas"
End Sub
and in my ThisWorkbook object, the BeforeSave event handler calls it each time the workbook is saved.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
WriteAllBas
End Sub
There's a second or two of overhead each time the workbook is saved.
Note: Under Office 2016 and earlier versions I didn't need to delete (Kill) the text file before exporting, but under Office 365 the Export method fails if the file exists.
I just save a date/timestamped copy of PERSONAL.xlsb to a backup drive location using the following code.
Sub PersonalBckup()
Const dstBak As String = "H:\PERSONAL MACROS\" 'change path to suit
Const dstBak2 As String = "D:\PERSONAL Macros\"
On Error Resume Next 'if either of the drives are not present, skip error.
Application.DisplayAlerts = False 'turn off warning popups
With Workbooks("PERSONAL.xlsb") 'name of your PERSONAL.xlsb file
.SaveCopyAs dstBak & "PERSONAL" & " as of " & Format(Now(), "YYYYMMDD_hhmmAMPM") & ".xlsb"
.SaveCopyAs dstBak2 & "PERSONAL" & " as of " & Format(Now(), "YYYYMMDD_hhmmAMPM") & ".xlsb"
.Save
End With
Application.DisplayAlerts = True 'Turn on warning popups
The backed-up file is saved with a date/timestamp: "PERSONAL as of 20180512_0136PM.xlsb"
I know this doesn't exactly answer the question, but perhaps it's still helpful. You can easily save all modules into a pdf by rigth clicking the modules folder and clicking print (and then clicking setup to change to print to pdf) . This won't give you a specific exported file that can be easily imported back in per se, but it keeps a safely saved file that you can always go back and reference should anything go wrong in your code. There's probably a way to automate this (or at least make it a one-time click when you save), but I haven't figured that out yet.
I have used Custom Fields in my DOCX file and update them using OpenXML, but custom fields are not getting updated in document.
So I have write following macro to update field, it run well on my machine, Now i want to deploy it on each machine at client side, the machine count is 500 I can not go on each machine and paste macro code in each normal.dot file
what is easy step to do it ? Or when I open word file, will application ask for installing macro ? like addin ?
Here is my macro
Private Sub Document_Open()
Dim aStory As Range
Dim aField As Field
For Each aStory In ActiveDocument.StoryRanges
For Each aField In aStory.Fields
aField.Update
Next aField
Next aStory
End Sub
I don't know how to deploy your macro; however, in a comparable situation I sent users a template with the new macros and asked them to run it. The template would distribute the new macros. I ued the following code for that. Note that it only copies Macro Proejct Items (modules), not single macros:
Sub AutoNew()
Deploy
End Sub
Sub AutoOpen()
Deploy
End Sub
Sub Deploy()
Dim src, dst
'
If (MsgBox("This will deploy new macros to your Normal.dot. Continue?", vbYesNo, "Deploy new macros") _
= vbNo) Then Exit Sub
On Error Resume Next
src = ActiveDocument.AttachedTemplate.FullName
dst = NormalTemplate.FullName
'
' Copy a macro/module
'
Application.OrganizerCopy Source:=src, Destination:=dst, _
Object:=wdOrganizerObjectProjectItems, Name:="Document_Open"
'
MsgBox "New macros have been copied to your Normal.dot. You can close this document now."
End Sub