I'm trying to edit tables within a Word Document using VBA. The following MsgBox returns 0 even though there are several tables within the document. Elsewhere in the macro, I am successfully editing a value in the Word Document with:
With WA.ActiveDocument
Set myRange = .Content
With myRange.Find
.Execute Findtext:="Sally", ReplaceWith:=FirstName, Replace:=1
EndWith
EndWith
MsgBox (WA.ActiveDocument.Content.Tables.Count)
Just use inside the With statement(if they are actual tables)
MsgBox .Tables.Count
You can verify by switching to the Word document itself and putting the following Msgbox ActiveDocument.Tables.Count in the ThisDocument part of the ActiveDocument. If the answer is still 0 then you are not working with Word Tables.
Related
Where I am working, we have software that converts an xml file into a word document. The only issue is that it can only do 1 xml file at a time, producing 1 word document at a time. I am trying to find a way to join all the word documents into 1. Here is the code I came up with.
Sub merge()
Dim myDoc As Documents
Dim count As Integer
Set myDoc = Documents
count = myDoc.count
If count <> 1 Then
For i = 1 To count - 1
myDoc(i).Select
Selection.WholeStory
Selection.Copy
myDoc(count).Range.Select
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.Paste
Next i
Else
MsgBox ("No other documents open")
End If
End Sub
The only issue I am running into is that when the software converts the xml file into a word document, the VBA does not recognize any of the converted documents even though it is open in MS Word. If I run code like "application.windows.count or documents.count" it will not recognize it. If I open any other document the code will merge everything together. But the converted documents from the software cannot be merged. Is there anything I can do to force MS Word to recognize the converted documents?
I have an embedded Word document (*.docm) in my Excel worksheet.
The Word document contains a table, that has relationship between its corresponding Table in Excel's WorkSheet.
I want count of table rows in embedded Word document been dynamically set in Document_Open event, with bellow value, from its involving Worksheet:
ThisWorkbook.Worksheets("Sheet1").ListObjects("Salary").ListRows.Count
How can I pass values between Excel (macro container document) and its embedded macro container word document? -If its a right answer for above bold issue- or another solution?
If there is another solution answer, Please note that cover need of:
Fill destination table (that is in embedded word document) cells with corresponding values from source data are in parent Table from Worksheet?, same instead of with auto generating fields with Document_Open events from macro container embedded word document.
I suggest to embed .docx document to avoid macros disabled alert each time it's opened, and to place all the code within Excel VBA Project. Here is the example, showing how to change number of rows in embedded Word document from Excel VBA:
Sub ChangeRowsCount()
Dim n As Long
With ThisWorkbook.Worksheets("Sheet1")
n = .ListObjects("Table1").ListRows.Count
With .Shapes("Object 1")
Select Case True
Case .Type <> msoEmbeddedOLEObject
MsgBox "Invalid OLE Object type"
Case InStr(1, .OLEFormat.progID, "Word.Document", vbTextCompare) <> 1
MsgBox "Invalid Application"
Case Else
.OLEFormat.Object.Verb xlVerbOpen
With .OLEFormat.Object.Object.Parent ' Word.Application
With .ActiveDocument.Tables(1).Rows
Do While .Count <> n
If .Count > n Then .Item(.Count).Delete Else .Add
Loop
End With
.Quit
End With
.Select
MsgBox "Success"
End Select
End With
End With
End Sub
I am using the below Macro to split the mail merged into separate documents. What I need is it to split into separate documents keeping the whole page including the header and footers and saving as in the first merged field on the page, which is the first piece of information on the merged letters.
However, the macro runs only on one letter not the rest, and the format is completely incorrect. It changes the font, page layout and does not include the headers and footers. It also saves as 'Ref' rather than the first merged field on the letter.
Does anyone have any idea how to amend the code below so it correctly updates with the above and for all letters please? I understand if this looks really bad but I am new to VBA and no one on my project to ask for help. Thanks in advance
Sub splitter()
' Based on a macro by Doug Robbins to save each letter created by a mailmerge as a separate file.
' With help from http://www.productivitytalk.com/forums/topic/3927-visual-basic-question-for-merge-fields/
Dim i As Integer
Dim Source As Document
Dim Target As Document
Dim Letter As Range
Dim oField As Field
Dim Ref As String
Set Source = ActiveDocument
For i = 1 To Source.Sections.Count
Set Letter = Source.Sections(i).Range
Letter.End = Letter.End - 1
For Each oField In Letter.Fields
If oField.Type = wdFieldMergeField Then
If InStr(oField.Code.Text, "Ref") > 0 Then
'get the result and store it the Ref variable
Ref = oField.Result
End If
End If
Next oField
Set Target = Documents.Add
Target.Range = Letter
Target.SaveAs FileName:="\\svr4958file01\Libraries\u20480\Documents\On Hold letters Template\20150512 On hold Letters Customers Active and Cancelled\" & "Ref"
Target.Close
Next i
End Sub
Offering an alternative answer to this old question as I recently had to solve it myself, and this question still ranks high up the results when searching for this issue.
I started with the macro at https://word.tips.net/T001538_Merging_to_Individual_Files.html, modifying it to first create separate blank documents based on the mail merge file, to preserve headers, footers and formatting. This may be an inefficient method, but doesn't require messing around with templates.
The following macro should be run from the mail merge output document which needs to be split.
Sub BreakOnSection()
'***Update the working folder location below***
ChangeFileOpenDirectory "C:\C:\Users\User\Downloads"
'***Update the original mail merge file name below***
mailmergeoriginal = "Original Mail merge.docx"
'Makes code faster and reduces screen flicker
Application.ScreenUpdating = False
'Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
SectionCount = ActiveDocument.Sections.Count
'Save a template for each mailmerge document
ActiveDocument.StoryRanges(wdMainTextStory).Delete
DocNum = 1
For i = 1 To (SectionCount - 1)
ActiveDocument.SaveAs FileName:="Mail merge " & DocNum & ".docx"
DocNum = DocNum + 1
Next i
ActiveDocument.SaveAs FileName:="Macro temp.docx"
Documents.Open FileName:= mailmergeoriginal
Documents("Combined Offers.docx").Activate
'A mailmerge document ends with a section break next page
DocNum = 1
For i = 1 To (SectionCount - 1)
'Select and copy the section text to the clipboard
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard
Documents.Open FileName:="Mail merge " & DocNum & ".docx"
'To save your document with the original formatting'
Selection.PasteAndFormat (wdFormatOriginalFormatting)
'Removes any break copied at the end of the section
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveDocument.SaveAs FileName:="Mail merge " & DocNum & ".docx"
ActiveDocument.Close
DocNum = DocNum + 1
'Move the selection to the next section in the document
Application.Browser.Next
Next i
End Sub
Please note that this macro will leave one extra file behind after running, called "Macro temp.docx", which I needed to keep open to keep the macro running. This file can safely be deleted after completion. This could probably be avoided, but I wanted to avoid needing to run the macro from a template and haven't come up with a better method.
This is just an answer to the second part:
This line:
If InStr(oField.Code.Text, "Ref") > 0 Then
Is finding the mergefield with "Ref" in it. If you need a different mergefield, you should put the name of the mergefield you wish to save the file as where "Ref" is, so if your mergefield is, "Addressee" then change it to:
If InStr(oField.Code.Text, "Address") > 0 Then
Also, your last line is saving the filename with the STRING "Ref" instead of the variable. You need to remove the quotes around Ref. It should read:
Target.SaveAs FileName:="\\svr4958file01\Libraries\u20480\Documents\On Hold letters Template\20150512 On hold Letters Customers Active and Cancelled\" & Ref
As far as the rest, you could use an alternative approach (I don't really have time to provide code for this right now). Find the first and last page of each range (which is set to variable Letter) and print out these pages to a word doc. This will keep the headers and footers. The code you will need to enter will be:
Letter.Information(wdActiveEndPageNumber)
to get the page number of the end of the range (not sure but I assume (wdActiveStartPageNumber) or something similar will get the first page of the range
and
Application.PrintOut From:=FirstPageNum, To:=LastPageNum, OutputFileName:=:="\\svr4958file01\Libraries\u20480\Documents\On Hold letters Template\20150512 On hold Letters Customers Active and Cancelled\" & Ref & ".doc"
Will update more later if I get the time.
I am working my way through two books (Roman's Writing Word Macros, Mansfield's Mastering VBA for MS Office). In my work environment, I use both Word 2007 and Word 2010.
My issue is that I want to use VBA to insert a very brief amount of standardized text before the English-language string in my numbered hierarchical headings. For instance, I have:
1.1.1 The Quick Brown Fox.
What I want is:
1.1.1 (XXxx) The Quick Brown Fox.
I guess my most basic issue is that I don't know how to approach the situation. I have hierarchical headings yet I don't know how to say, in effect, "Go to each hierarchical heading regardless of level. Insert yourself in front of the first English language word of the heading. Paste the text "XXxx" in front of the first word in the heading. Go on to the next heading and all remaining headings and do the same. My document is over 700 pages and has hundreds of hierarchical headings.
I see that paragraphs are objects and that hierarchical headings are paragraphs. However, I can't see any way to make VBA recognize what I am talking about. I haven't been able to use Selection approaches successfully. I've tried using the Range approach but just have not been able to phrase the VBA code intelligently. I haven't been able to specify a range that includes all and only the hierarchical headings and, especially, I don't understand how to get the insertion to happen in front of the first English-language word of the heading.
I have just begun to look at using Bookmarks. However, don't bookmarks require me to go to every heading and enter them? I may as well just paste my content if that is the case. I'm stumped. It is interesting that in no way, as might have been expected, does this appear to be a simple matter
Assuming you are using Word's outline levels (I think this is what you mean by hierarchical headings), you can check a paragraph for this state. For example, assuming I have a paragraph in my document that has the Heading 1 style applied to it:
Sub PrintHeadings()
Dim objDoc as Document
Dim objPara as Paragraph
Set objDoc = ActiveDocument
For each objPara in objDoc.Content.Paragraphs
If objPara.OutlineLevel <> wdOutlineLevelBodyText then
Debug.Print objPara.Range.Text
End If
Next objPara
End Sub
This code would print the contents of any paragraph that has an outline level above body text to the VBA Immediate Window. There are other approaches as well; you could use Find and Replace to search for each of the Outline Levels. This gives you a bit less control; you'd want your change to be something that could be encapsulated in a Word Find and Replace. But, it would be faster if you have a long document and not too many heading levels. A basic example:
Sub UnderlineHeadings()
Dim objDoc as Document
Set objDoc = ActiveDocument
With objDoc.Content.Find
.ClearFormatting
.ParagraphFormat.OutlineLevel = wdOutlineLevel1
With .Replacement
.ClearFormatting
.Font.Underline = wdUnderlineSingle
End With
.Execute Forward:=True, Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceAll
End With
End Sub
That would underline all of your text of Outline Level 1.
Perhaps that will get you started.
I asked this question some months ago: "My issue is that I want to use VBA to insert a very brief amount of standardized text before the English-language string in my numbered hierarchical headings." By "numbered hierarchical headings" I meant Word multilevel lists. The answers I received were appreciated but did not respond effectively to my question or guide me to a resolution. I pass this along in the hope it may be of use to others.
First, the "number" part of the Word heading is irrelevant. In writing your code, there is NO need to think of a "number" portion and a "text" portion of the heading. I was afraid that any text I was trying to insert would be inserted BEFORE the multilevel numbering rather than BEFORE the English language text. The multilevel numbering is apparently automatically ignored. Below are two solutions that worked.
This first macro succeeded in producing the desired result: 1.1.1 (FOUO). I used this macro to create individual macros for each order of heading. I haven't learned how to combine them all into one macro. But they work individually (but not without the flaw of taking too much time ~5 to 10 minutes for a complex, paragraph-heavy 670 page document).
Public Sub InsertFOUOH1()
Dim doc As Document
Dim para As Paragraph
Dim paraNext As Paragraph
Dim MyText As String
Dim H1 As HeadingStyle
Set doc = ActiveDocument
Set para = doc.Paragraphs.First
Do While Not para Is Nothing
Set paraNext = para.Next
MyText = "(U//FOUO) "
If para.Style = doc.Styles(wdStyleHeading1) Then
para.Range.InsertBefore (MyText)
End If
Set para = paraNext
Loop
End Sub
THIS WORKS ON ALL FIRST ORDER HEADINGS (1, 2, 3 ETC.)
I used the macro below to add my security marking all body paragraphs:
Public Sub InsertFOUObody()
'Inserts U//FOUO before all body paragraphs
Dim doc As Document
Dim para As Paragraph
Dim paraNext As Paragraph
Dim MyText As String
Set doc = ActiveDocument
Set para = doc.Paragraphs.First
Do While Not para Is Nothing
Set paraNext = para.Next
MyText = "(U//FOUO) "
If para.Style = doc.Styles(wdStyleBodyText) Then
para.Range.InsertBefore (MyText)
End If
Set para = paraNext
Loop
End Sub
These macros are running slowly and, at the end, generating Error 28 Out of stack space errors. However the error is displayed at the end of running the macros and after the macros have successfully performed their work.
I am currently creating a large script to automate a Microsoft word document to pull out tables and put them into a new document. But I need to know when I reach the end of the document so I can move on to the next document.
Set objWord = CreateObject("Word.Application")
Set objNewDoc = objWord.Documents.Add()
Set objNewSelection = objWord.Selection
Set objDoc = objWord.Documents.Open( C:/Users/blahdoc.doc )
Set objSelection = objWord.Selection
This isn't the script but its how I defined and opened the documents for reading. I will happily insert more details if and when there needed.
I did look around for similar questions but didn't find any that apply. If you do sorry ahead of time ;)
You actually don't need to worry about "reaching the end of the document." Thankfully, the tables are stored in a Tables collection which is a property of a Word.Document. You can iterate through all the tables like so:
For Each oTable In objNewDoc.Tables
If Left(oTable.Cell(1, 1).Range.Text, Len(oTable.Cell(1, 1).Range.Text) - 2) = "Some string" Then
MsgBox "Found one!"
End If
Next
One issue I ran into when putting this together is that all Cells' Text have an End-of-Cell Marker composed of two characters: a Carriage Return (ascii 13) followed by a BELL (ascii 7). I used Left to strip those off so I could compare the text against a string value, which is what I understand you are trying to do.