I want to use Excel to store "tag names" in column A and their associated "replacement text" in Column B. When the code runs, it needs to collect each tag, one at a time (row by row), search an entire Word document for those words, and replace them with their corresponding replacements.
I noticed the special tags in the headers and footers weren't being replaced. I turned to this article (http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm) and found that working with a range of ranges (or cycling through all available Story Ranges in the document) I was able to do this.
I improved my code, as recommended in the link above and it worked, so long as my code was embedded in my "Normal" Word file, thereby using my VBA code from Word to operate on another Word document. However, the goal is to use VBA Excel to operate the replacements while reading an Excel file.
When I moved the code to Excel, I'm getting hung up on an Automation error which reads,
"Run-time error '-2147319779 (8002801d)': Automation error Library not registered.".
I've looked for answers from reviewing the Registry to using "Word.Application.12" in place of "Word.Application".
I have a Windows 7, 64-Bit machine, with Microsoft Office 2007. I have the following libraries selected:
Excel:
Visual Basic For Applications
Microsoft Excel 12.0 Object Library
OLE Automation
Microsoft Access 12.0 Object Library
Microsoft Outlook 12.0 Object Library
Microsoft Word 12.0 Object Library
Microsoft Forms 2.0 Object Library
Microsoft Office 14.0 Object Library
Word:
Visual Basic For Applications
Microsoft Word 12.0 Object Library
OLE Automation
Microsoft Office 12.0 Object Library
I have no issues with operating inside of Excel with regard to VBA. Normally, I will be passing a set of strings to this function, but for now, I have embedded the strings inside of the function, as if I am only planning on swapping one string (for any number of instances), with another predetermined string.
Function Story_Test()
Dim File As String
Dim Tag As String
Dim ReplacementString As String
Dim a As Integer
Dim WordObj As Object
Dim WordDoc As Object
Dim StoryRange As Word.Range
Dim Junk As Long
Dim BaseFile As String
'Normally, these lines would be strings which get passed in
File = "Z:\File.docx"
Tag = "{{Prepared_By}}"
ReplacementString = "Joe Somebody"
'Review currently open documents, and Set WordDoc to the correct one
'Don't worry, I already have error handling in place for the more complex code
Set WordObj = GetObject(, "Word.Application")
BaseFile = Basename(File)
For a = 1 To WordObj.Documents.Count
If WordObj.Documents(a).Name = BaseFile Then
Set WordDoc = WordObj.Documents(a)
Exit For
End If
Next a
'This is a fix provided to fix the skipped blank Header/Footer problem
Junk = WordDoc.Sections(1).Headers(1).Range.StoryType
'Okay, this is the line where we can see the error.
'When this code is run from Excel VBA, problem. From Word VBA, no problem.
'Anyone known why this is???
'***********************************************************************
For Each StoryRange In WordObj.Documents(a).StoryRanges
'***********************************************************************
Do
'All you need to know about the following function call is
' that I have a function that works to replace strings.
'It works fine provided it has valid strings and a valid StoryRange.
Call SearchAndReplaceInStory_ForVariants(StoryRange, Tag, _
ReplacementString, PreAdditive, FinalAdditive)
Set StoryRange = StoryRange.NextStoryRange
Loop Until StoryRange Is Nothing
Next StoryRange
Set WordObj = Nothing
Set WordDoc = Nothing
End Function
For Each StoryRange In WordObj.Documents(a).StoryRanges
should probably be
For Each StoryRange In WordDoc.StoryRanges
since you just assigned that in the loop above.
For now, I will have to conclude, as I don't have the possibility of testing the contrary, that there is a difference between using Microsoft Office 12 Object Library in one VBA environment, and Microsoft Office 14 Object Library in another. I don't have the means/authorizations to change either, so I must conclude, for now that is, that the difference between the two is the culprit. So, if I was to go forward and expect different results, I would assume Microsoft Office 12 Object Library to be the correct library, where 14 has a few differences that I am not aware of.
Thank you to all who provided input. If you have any other suggestions, we can discuss and forward. Thanks!
This is to update a bunch of links spread over body & Headers footers.
I didn't write this only from memory made a bunch of fixes, inclusions and tweaks.
It shows you how to cover all the different sections and can easily be modified to work within your parameters.
Please post your final code once done.
Public Sub UpdateAllFields()
Dim doc As Document
Dim wnd As Window
Dim lngMain As Long
Dim lngSplit As Long
Dim lngActPane As Long
Dim rngStory As Range
Dim TOC As TableOfContents
Dim TOA As TableOfAuthorities
Dim TOF As TableOfFigures
Dim shp As Shape
Dim sctn As Section
Dim Hdr As HeaderFooter
Dim Ftr As HeaderFooter
' Set Objects
Set doc = ActiveDocument
Set wnd = ActiveDocument.ActiveWindow
' get Active Pane Number
lngActPane = wnd.ActivePane.Index
' Hold View Type of Main pane
lngMain = wnd.Panes(1).View.Type
' Hold SplitSpecial
lngSplit = wnd.View.SplitSpecial
' Get Rid of any split
wnd.View.SplitSpecial = wdPaneNone
' Set View to Normal
wnd.View.Type = wdNormalView
' Loop through each story in doc to update
For Each rngStory In doc.StoryRanges
If rngStory.StoryType = wdCommentsStory Then
Application.DisplayAlerts = wdAlertsNone
' Update fields
rngStory.Fields.Update
Application.DisplayAlerts = wdAlertsAll
Else
' Update fields
rngStory.Fields.Update
End If
Next
'Loop through text boxes and update
For Each shp In doc.Shapes
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
Next
' Loop through TOC and update
For Each TOC In doc.TablesOfContents
TOC.Update
Next
' Loop through TOA and update
For Each TOA In doc.TablesOfAuthorities
TOA.Update
Next
' Loop through TOF and update
For Each TOF In doc.TablesOfFigures
TOF.Update
Next
For Each sctn In doc.Sections
For Each Hdr In sctn.Headers
Hdr.Range.Fields.Update
For Each shp In Hdr.Shapes
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
Next shp
Next Hdr
For Each Ftr In sctn.Footers
Ftr.Range.Fields.Update
For Each shp In Ftr.Shapes
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
Next shp
Next Ftr
Next sctn
' Return Split to original state
wnd.View.SplitSpecial = lngSplit
' Return main pane to original state
wnd.Panes(1).View.Type = lngMain
' Active proper pane
wnd.Panes(lngActPane).Activate
' Close and release all pointers
Set wnd = Nothing
Set doc = Nothing
End Sub
Related
Why is following code running from MS Word (MailMerge main document) freezing the application on ThisDocument.Close False?
Do I need to close the Scripting.Dictionary in some way other than setting the object to nothing?
There is only one instance of Word active, it is visible, ThisDocument is not the active document.
I am even explicitly activating the last opened document, even if it is already active. Not sure if I even need to set the oWorkbook and oExcel to nothing.
Sub MailMergeAlternative()
Dim oExcel As Object
Dim oWorkbook As Object
Dim oFirstCell As Object
Set oExcel = CreateObject("Excel.Application")
Set oWorkbook = oExcel.workbooks.Open(SOUBOR)
Set oFirstCell = oWorkbook.sheets(SESIT).Cells(1, 1)
Dim Dict As Object
Set Dict = MakeDictionary() ' Scripting.dictionary
Dim oDoc As Object
Dim Radek As Long
Dim Radku As Long
Radku = oFirstCell.currentregion.Rows.Count
For Radek = 2 To Radku
' ... fill Dict, use MailMerge to create new document for active record ...
Set oDoc = ActiveDocument ' the new document after MailMerge
' ... insert values, save the new document, do not close it ...
Next
Closing:
oDoc.Activate ' <== set to active, not needed
Set Dict = Nothing
oWorkbook.Close
oExcel.Quit
Set oWorkbook = Nothing ' probably not needed, closed above
Set oExcel = Nothing ' probably not needed, closed above
ThisDocument.Close False ' <== Problem
End Sub
Expected:
The code runs, creates new document(s) and closes the document which is containing the macro and from where it was called. The last active document stays open (the newly created one), or if nothing was created, Word app closes.
What is happening:
The document closes, the last active document stays open. But Word freezes and the document needs to be found in Task Manager and "brought to foreground". This is not a problem when using MailMerge alone (with additional vba work) and seems to be connected to use of Excel and Scripting.Dictionary.
Since you don't provide a [mcve] so that we can test exactly what you're doing it's possible that the following solution won't work for your exact environment. My test was run on the code below, which essentially creates a number of new documents then closes a document. (I have no access to your Excel content or to MakeDictionary())
I created a template (dotm) and put the code in that, closed it, created a new document from the template. This document has access to the code, via its link to the template. Closing the document will also release the template (unless another document based on it is opened). But in my test the code finished without an error.
Sub TestCloseSelfDocument()
Dim docMmMainMerge As Word.Document
Set docMmMainMerge = ActiveDocument
Dim Dict As Object
Dim oDoc As Object
Dim Radek As Long
Dim Radku As Long
Radku = 5
For Radek = 2 To Radku
Documents.Add
' ... fill Dict, use MailMerge to create new document for active record ...
Set oDoc = ActiveDocument ' the new document after MailMerge
' ... insert values, save the new document, do not close it ...
Next
Closing:
Set Dict = Nothing
docMmMainMerge.Close False
End Sub
Receiving a Runtime Error '13' exception when creating a word application object. I also was experiencing relatively extreme delays (on the order of 20-30 seconds) of running prior to the exception. Any idea what this could be from? I searched Stackoverflow and I haven't seen anything that was very similar.
I have never worked with an word doc from excel before so this is something new to me.
Code Below:
Public Sub GetRawData()
'Meant to translate data from a raw word file and format into excel
Dim filePath As String
Dim objWord As Application
Set objWord = CreateObject("Word.Application")
Dim objDoc As Word.Document
'File management vars
Dim oneLine As Paragraph
Dim lineText As String
filePath = "U:\Research_Dev Docs\DevFolder\Word Doc Translation In Excel For Phys\testWordDoc.docx"
'Set word doc object using standard file directory and file name
Set objDoc = objWord.Documents.Open(Filename:=filePath, Visible:=True)
For Each oneLine In objDoc.Paragraphs
'Pull in each line and eventually parse
lineText = oneLine.Range.Text
'DEBUG OUTPUT TO THE SCREEN FOR TESTING
MsgBox (lineText)
Next oneLine
End Sub
Background
I have a Word-macro in Normal.dotm that opens an Excel-workbook Reference Check.xlsm.
The macro uses RegExp as well as Range.Find to find strings of a certain pattern, and then it places this information onto sheets in the Excel-workbook.
This is the basic template:
Sub GetReferencesAndHyperlinksToExcel()
' Shortcut Key: Ctrl+[Num *]
Dim oRegex As New RegExp
Dim oRegExMatches As MatchCollection
Dim oRegExMatch As Match
Const strPattern As String = "(my pattern)"
Dim SourceDocument As Document
Dim oStory As Range
Dim hl As Hyperlink
Dim xlApp As New Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim R as Excel.Range
' Set the context
Set SourceDocument = ActiveDocument
' Load the spreadsheet
Set xlWorkbook = xlApp.Workbooks.Open("C:\...\Reference Check.xlsm")
' Set starting range to write to
With xlWorkbook.Worksheets("Reference Checks")
.Range("ref").ClearContents
Set R = .Range("ref")(1, 1)
End With
' Initialise regex
With oRegex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
' ==== Iterate through story ranges, then execute regex and write matches and hyperlinks to the spreadsheet ====
' ==== Iterate through story ranges, then iterate through hyperlinks and write hyperlinks to the spreadsheet ====
End Sub
The Excel-workbook does some calculations and lookups (with pre-filled column formulas) against a Data Table within the Workbook.
Using that information, I manipulate the active Word document (the "caller" or the "context") in predictable^ ways.
^If it's predictable, then we should be able to use a macro to do the work for us.
The problem
I want to use the now-open Excel workbook Reference Checks.xlsm as a "console" or "controller", where I can change some data, and use data, to perform operations on (make changes to) the document.
To do this, I believe I need to somehow be able to refer to the original "caller" or "context", i.e. the Word document that was Active when I originally called it (Set SourceDocument = ActiveDocument), from within the now-open Workbook. This means that either:
Macros within Excel (tied to Buttons) Reference Check.xlsx act on SourceDocument (preferred), or
Macros within Excel (tied to Buttons) Reference Check.xlsx call a Macro within Word Normal.dotm and then act on the SourceDocument* (if this is possible, the above should be), or
Various macros within Normal.dotm act on SourceDocument* (workable, but clunky)
*Note: This must actually be SourceDocument (the "caller" or "context") and not ActiveDocument, because it is possible that as I switch between windows, another document could become ActiveDocument.
Things I've thought of
For option 1, use a global variable in Reference Checks.xlsm, then when I load the workbook, set the reference to SourceDocument. This is my preferred option. I have no idea how to do this, however.
For option 3, use a global variable in Normal.dotm, set the reference to the workbook when I open it, then read information in the workbook when I call the macros. A drawback would be that I have many macros I might call, and I would have to have many public subs (makes Normal.dotm quite unwieldy).
Help
How do I do this?
I have tested this and it worked perfectly with Office 2010.
Note that you need the Excel Library in your Word Normal Template and the Word Library in the Excel Reference Check.xlsm
You will need the following:
Sub in the ThisWorkBook module in the Reference Check.xlsm.
So in your Excel VBA Project -> Microsoft Excel Objects -> ThisWorkBook
Option Explicit
Sub ExcelWordController(WordDocFromWord As Document)
'If you are wanting to use it as a Document then _
you will need the Word Library in Excel
MsgBox WordDocFromWord
'Just put some funny text inthe doc for a test
WordDocFromWord.Range(0, 0).Text = "Yeah Baby It works"
'Here you can then call someother Sub or so some processing
End Sub
Then in your Word Normal project:
Option Explicit
'Sub in Word Normal
Sub ExcelControlWordFromWordInitiation()
'Obvisouly you alrady have the Excel Library in the Word Doc
Dim xlApp As New Excel.Application
'xlWorkbook is a object in the Word Excel Library
'So I changed the name
Dim RefCheckWorkBook As Excel.Workbook
Dim R As Excel.Range
Dim SourceDocument As Document
Set SourceDocument = ActiveDocument
'You want to be able to see the Excel Application
xlApp.Visible = True
Set RefCheckWorkBook = xlApp.Workbooks.Open(Environ("USERPROFILE") & "\Desktop\Reference Check.xlsm")
'Calling the Sub in Excel from Word
Excel.Application.Run "ThisWorkBook.ExcelWordController", SourceDocument
End Sub
This question is related with a previous one.
I have an open Word document with a bunch of bookmarks, each with an inline image of an Excel table previously exported from Excel.
Now, I need to update the tables in the Word document as they have changed in Excel.
The way I'm doing this is matching the table names in Excel with the bookmark names in Word. If they are equal than I want to replace the existing images in Word by the current ones.
This is my code so far:
Option Explicit
Sub substituir()
Dim Mark As String
Dim Rng As Range
Dim ShpRng As Range
Dim WordApp As Object
Dim DocumentoDestino As Object
Dim folha As Worksheet
Dim tabela As ListObject
Dim nomeTabela As String
Set WordApp = GetObject(class:="Word.Application")
Set DocumentoDestino = WordApp.ActiveDocument
For Each folha In ThisWorkbook.Worksheets
If folha.Visible Then
'loop all excel tables
For Each tabela In folha.ListObjects
tabela.Name = Replace(tabela.Name, " ", "")
Mark = CStr(tabela.Name)
With ActiveDocument
If .Bookmarks.Exists(Mark) Then
Set Rng = .Bookmarks(Mark).Range ' returns runtime error 13: Type mismatch, I guess it is because .Bookmarks expects the bookmark index instead of the name.
If Rng.InlineShapes.Count Then
Set ShpRng = Rng.InlineShapes(1).Range
With ShpRng
Debug.Print .Start, .End
ShpRng.Delete
End With
End If
End If
End With
Next tabela
End If
Next folha
End Sub
The code seems ok, except for the line marked above that returns runtime error 13, is there any way to get to the bookmark index instead of the name or another way to fix the issue?
Thanks in advance!
The problem is from the Range object. There is such an object in Excel as well as in Word. Since you are running Excel, both Rng and ShpRng are declared as Excel ranges implicitly. Declare them as Word.Range.
Quite generally, be more careful with your use of variables. You perfectly declared Set DocumentoDestino = WordApp.ActiveDocument, but then you proceed with
With ActiveDocument
If .Bookmarks.Exists(Mark) Then
In Excel, there is no ActiveDocument. Perhaps that is why Excel correctly divines your intention to refer to DocumentoDestino. However, if you don't keep tight control instances are likely to arise - whenever you least expect them, of course - when Excel makes the wrong guess.
I'm getting this error, "Microsoft Excel is waiting for another application to complete an OLE action" when trying to automate a PDF string search and record findings in excel. For certain PDFs this error is not popping. I assume this is due to the less optimized PDFs taking a longer time to search string while indexing page by page.
To be more precise, I have a workbook containing two sheets. One contains a list of PDF file names and the other has a list of words that I want to search. From the file list the macro would open each PDF file and take each word from the list of words and perform a string search. If found it would record each finding in a new sheet in the same workbook with the file name and the found string.
Below is the code I'm struggling with. Any help is welcome.
Public Sub SearchWords()
'variables
Dim ps As Range
Dim fs As Range
Dim PList As Range
Dim FList As Range
Dim PLRow As Long
Dim FLRow As Long
Dim Tracker As Worksheet
Dim gapp As Object
Dim gAvDoc As Object
Dim gPDFPath As String
Dim sText As String 'String to search for
FLRow = ActiveWorkbook.Sheets("List Files").Range("B1").End(xlDown).Row
PLRow = ActiveWorkbook.Sheets("Prohibited Words").Range("A1").End(xlDown).Row
Set PList = ActiveWorkbook.Sheets("Prohibited Words").Range("A2:A" & PLRow)
Set FList = ActiveWorkbook.Sheets("List Files").Range("B2:B" & FLRow)
Set Tracker = ActiveWorkbook.Sheets("Tracker")
'For each PDF file list in Excel Range
For Each fs In FList
'Initialize Acrobat by creating App object
Set gapp = CreateObject("AcroExch.App")
'Set AVDoc object
Set gAvDoc = CreateObject("AcroExch.AVDoc")
'Set PDF file path to open in PDF
gPDFPath = fs.Cells.Value
' open the PDF
If gAvDoc.Open(gPDFPath, "") = True Then
'Bring the PDF to front
gAvDoc.BringToFront
'For each word list in the range
For Each ps In PList
'Assign String to search
sText = ps.Cells.Value
'This is where the error is appearing
If gAvDoc.FindText(sText, False, True, False) = True Then
'Record findings
Tracker.Range("A1").End(xlDown).Offset(1, 0) = fs.Cells.Offset(0, -1).Value
Tracker.Range("B1").End(xlDown).Offset(1, 0) = ps.Cells.Value
End If
Next
End If
'Message to display once the search is over for a particular PDF
MsgBox (fs.Cells.Offset(0, -1).Value & " assignment complete")
Next
gAvDoc.Close True
gapp.Exit
set gAVDoc = Nothing
set gapp = Nothing
End Sub
I have now found the answer to this problem.
I'm using Acrobat Pro and whenever I open a PDF file, it opens with limited features due to Protected View settings. If I disable this function or if I click Enable All Features and save changes to the PDF files, VBA macro runs smooth.
It's funny, I'm posting an answer to my own problem.