I have to transfer hundreds of word documents into excel. The documents are client records from way back, and they look like this:
Date: dd/mm/yy
Employee name: Name
Several lines of text in one paragraph.
There will be dozens of entrees on the page like this, formatted into one column. I need the end result to be one column for each category. The major challenge with this is the text descriptions. The way they are formatted in word, there doesn't seem to be a simple way to copy and paste them into excel without the result being one cell for each line of the paragraph. Any method I've tried that replaces hard returns for soft returns takes all the text on the entire page and puts into one cell, which makes it worse. I have hundreds of files to transfer, so I don't have the time to copy and paste each note into one cell. The paragraphs also are not uniform in length, although there is typically an empty line before and after the note starts/ends. I'm sure there must be a VB solution for this, but I'm not knowledgeable enough to figure it out. Any help would be appreciated.
You can set Bookmarks in Word, and import all Bookmarks into ranges in Excel.
Sub TryThis()
Dim oWord As Word.Application
Dim oDoc As Word.document
Dim vBkMarks As Variant
Dim vRecord
Dim rRecord As Range
Dim nFields As Long
Dim i As Long
vBkMarks = Array("Bookmark1", "Bookmark2", "Bookmark3") 'etc...
ReDim vRecord(LBound(vBkMarks) To UBound(vBkMarks))
nFields = UBound(vBkMarks) - LBound(vBkMarks) + 1
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
On Error GoTo 0
If oWord Is Nothing Then _
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.ActiveDocument
For i = LBound(vBkMarks) To UBound(vBkMarks)
vRecord(i) = oDoc.Bookmarks(vBkMarks(i)).Range.Text
Next i
With Sheets("DataTable")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize( _
1, nFields).Value = vRecord
End With
End Sub
Related
Using MS Word (in my case 2010 version), I have constructed a form with Content Control elements to be filled out by the user. Now I want certain entries (that I already gave titles to) be shown in a chart inside the same Word document (not in a separate Excel document).
This should be an automated process, so that if the user changes one of the Content Control entries, the chart updates itself automatically; I would also be OK if the user had to press a button in order to update the chart (but the user shouldn't have to click around a lot, since I must assume the user to have little skills.)
So I inserted an Excel chart object in my Word form document. I also wrote some VBA code inside this Excel object to read the Content Control values from the Word document as source for the chart. But I think what I really need is the VBA code to be in my Word document itself (for example to be executed upon click on a button by the user), yet I don't know how to address the Excel chart object and the cells within.
My VBA code inside the Excel object is:
Sub ChartDataAcquirer()
Dim wdApp As Object
Dim wdDoc As Object
Dim DocName As String
Dim ccX As String
Dim ccY As String
Dim datapairs As Integer
'''''''''' Variables '''''''''
DocName = "wordform.docm"
ccX = "titleX"
ccY = "titleY"
datapairs = 5
''''''''''''''''''''''''''''''
Set wdApp = GetObject(, "Word.Application")
Set wdDoc = wdApp.Documents(DocName)
Dim i As Integer
For i = 1 To datapairs
With ActiveSheet.Cells(i + 1, 1) ' The first row contains headline, therefore i+1
.Value = wdDoc.SelectContentControlsByTitle(ccX & i).Item(1).Range.Text ' The CC objects containing the x values have titles "titleX1", "titleX2" ..., therefore "ccX & i"
On Error Resume Next
.Value = CSng(wdDoc.SelectContentControlsByTitle(ccX & i).Item(1).Range.Text) ' To transform text into numbers, if user filled the CC object with numbers (which he should do)
End With
With ActiveSheet.Cells(i + 1, 2)
.Value = wdDoc.SelectContentControlsByTitle(ccY & i).Item(1).Range.Text
On Error Resume Next
.Value = CSng(wdDoc.SelectContentControlsByTitle(ccY & i).Item(1).Range.Text)
End With
Next
End Sub
I guess I need a similar code that is placed in and operates from the Word form document itself, but that is where I am stuck...
The following is demo code that shows how to access an embedded Excel chart.
Note that the Name (Shapes([indexValue])) of your chart Shape is probably different than in this code. You'll need to check and change that assignment. Also, your chart may be an InlineShape rather than a Shape, so you may need to adjust that bit, as well.
This code checks whether the Shape is actually a chart. If it is, the Chart object is accessed as well as its data sheet. Via that, it's possible to get the actual workbook, the worksheets, even the Excel application if you should need it.
Sub EditChartData()
Dim doc As Word.Document
Dim shp As Word.Shape
Dim cht As Word.Chart
Dim wb As Excel.Workbook, ws As Excel.Worksheet, xlApp As Excel.Application
Set doc = ActiveDocument
Set shp = doc.Shapes("MyChart")
If shp.HasChart Then
Set cht = shp.Chart
cht.ChartData.Activate
Set wb = cht.ChartData.Workbook
Set xlApp = wb.Application
Set ws = wb.ActiveSheet
Debug.Print ws.Cells(1, 2).Value2
End If
Set ws = Nothing
Set wb = Nothing
Set cht = Nothing
Set xlApp = Nothing
End Sub
Hi I'm trying to write code to use excel to work with two existing word documents but I keep getting OLE errors. This is just the start but it keeps crashing. What am I doing wrong?
Sub BoQtoWord()
Dim Word As Object
Dim WordDoc As Object
Dim WordDoc1 As Object
Dim StdSpec As String
Dim NewSpec As String
StdSpec = Application.GetOpenFilename()
Set Word = CreateObject("Word.Application")
Set WordDoc = Word.Documents.Open(StdSpec)
Sheet1.Range ("A1").Value = StdSpec
NewSpec = Application.GetOpenFilename()
Set WordDoc1 = Word.Documents.Open(NewSpec)
Sheet1.Range("A2").Value = NewSpec
End Sub
It seems to works fine on my end, albeit a bit slow, at least as far as writing the file paths to cells A1 and A2 is concerned. Beyond that we'd need to see more of your code.
Depending on what you're trying to accomplish with the Word objects the OLE problems might stem from conflicts in your references, make sure you check what libraries you are referencing (Tools/References...) for any possible conflict.
Another possible conflict might be the use of the word "Word" as your variable name for the object. Word is also a key name when using the Microsoft Word library, try using a different name see if that helps at all.
Speaking of which, by adding the Microsoft Word library to your references you can skip the step to create the word object, you can directly create a word.document object instead, like this:
Sub BoQtoWord()
Dim WordDoc As Word.Document
Dim WordDoc1 As Word.Document
Dim StdSpec As String
Dim NewSpec As String
'Get first doc
StdSpec = Application.GetOpenFilename()
Set WordDoc = Documents.Open(StdSpec)
Sheet1.Range("A1").Value = StdSpec
'Get second doc
NewSpec = Application.GetOpenFilename()
Set WordDoc1 = Documents.Open(NewSpec)
Sheet1.Range("A2").Value = NewSpec
'Do something with the documents opened
End Sub
Maybe that would solve your OLE problems.
Hope this points you in the right direction, if anything, a bit more information might help narrow down the issue!
Goal for my project:
I want to be able to copy the contents of one document and append that selection to the end of another document.
What it does... (this is just background info so you understand why I am trying to do this):
I am trying to dynamically produce a document which quotes a variety of information regarding different parts and materials involved for a product.
The document itself has a consistent format which I have broken down and separated into two documents. The first contains a bunch of data that needs to be entered manually, and is where I want to append all additional content. The second contains roughly a dozen custom fields which are updated from an excel spreadsheet in VBA. For a single part and as a single doc this works as I want it (my base case). However my issue is when there are multiple parts for a project.
The Problem:
For multiple parts I have to store information in an array which changes in size dynamically as each additional part is added. When someone has added all the necessary parts they can select a button called "Create Quote".
Create quote runs a procedure which creates/opens separate copies of the two template documents mentioned above (saved on my computer). It then iterates through the array of parts and updates all the custom field in the 2nd document (no problems). Now I just need the contents of the 2nd document appended to the end of the first which is my problem.
What I want:
Ideally, my procedure will continue to iterate through every part in the array - updating custom fields, copy then paste the updated text, repeat... Until every part is included in the newly generated quote.
What I Tried - this code can be found in my generate quote procedure
I have tried many of the examples and suggestions provided by people who had similar question, but I don't know if its because I am operating from an excel doc, but many of their solution have not worked for me.
This is my most recent attempt and occurs after each iteration of the for loop
wrdDoc2.Fields.Update 'Update all the fields in the format document
wrdDoc2.Activate
Selection.WholeStory ' I want to select the entire document
Selection.Copy ' Copy the doc
wrdDoc1.Activate ' Set focus to the target document
Selection.EndKey wdStory ' I want the selection to be pasted to the end of the document
Selection.PasteAndFormat wdPasteDefault
QUOTE PROCEDURE - I am only including a handful of the fields I am updating because its not necessary to show them all
Private Sub quote_button_Click()
On Error GoTo RunError
Dim wrdApp1, wrdApp2 As Word.Application
Dim wrdDoc1, wrdDoc2 As Word.Document
Set wrdApp1 = CreateObject("Word.Application")
Set wrdApp2 = CreateObject("Word.Application")
wrdApp1.Visible = True
wrdApp2.Visible = True
Set wrdDoc1 = wrdApp1.Documents.Add(Template:="C:\MWES\AQT_v1.1(start).docm", NewTemplate:=False, DocumentType:=0)
Set wrdDoc2 = wrdApp2.Documents.Add(Template:="C:\MWES\AQT_v2.1(format).docm", NewTemplate:=False, DocumentType:=0)
Dim propName As String
For i = LBound(part_array, 1) To UBound(part_array, 1)
For Each prop In wrdDoc2.CustomDocumentProperties
propName = prop.name
' Looks for and sets the property name to custom values of select properties
With wrdDoc2.CustomDocumentProperties(propName)
Select Case propName
Case "EST_Quantity"
.value = part_array(i, 0) ' "QTY" ' Sheet1.Cells(1, 3) 'NA
Case "EST_Metal_Number"
.value = part_array(i, 1) ' "METAL_#" ' Sheet1.Cells(2, 3) 'NA"
Case "EST_Metal_Name"
.value = part_array(i, 2) ' "METAL_N" ' Sheet1.Cells(5, 2)
End Select
End With
Next prop ' Iterates until all the custom properties are set
wrdDoc2.Fields.Update 'Update all the fields in the format document
wrdDoc2.Activate
Selection.WholeStory ' I want to select the entire document
Selection.Copy ' Copy the doc
wrdDoc1.Activate ' Set focus to the target document
Selection.EndKey wdStory ' I want the selection to be pasted to the end of the document
Selection.PasteAndFormat wdPasteDefault
Next i ' update the document for the next part
RunError: ' Reportd any errors that might occur in the system
If Err.Number = 0 Then
Debug.Print "IGNORE ERROR 0!"
Else
Dim strError As String
strError = "ERROR: " & Err.Number & vbCrLf & Err.Description & vbCrLf & Erl
MsgBox strError
Debug.Print strError & " LINE: " & Erl
End If
End Sub
I apologize this was so long winded. Let me know if there is anything confusing or you may want clarified. I think I included everything though.
I think you're close, so here are a couple of comments and an example.
First of all, you're opening two separate MS Word Application objects. You only need one. In fact, it's possible that the copy/paste is failing because you're trying to copy from one Word app to a document opened in the other. (Trust me, I've seen weird things like this.) My example below shows how to do this by only opening a single application instance.
Dim mswApp As Word.Application
Set mswApp = AttachToMSWordApplication() 'more on this function below...
Dim doc1 As Word.Document
Dim doc2 As Word.Document
Set doc1 = mswApp.Documents.Open("C:\Temp\combined.docx")
Set doc2 = mswApp.Documents.Open("C:\Temp\control.docx")
While I don't often write code for Word, I've found that there are so many different ways to get at the same content using different objects or properties. This is always a source of confusion.
Based on this answer, which has worked well for me in the past, I then set up the source and destination ranges to perform the "copy":
Dim destination As Word.Range
Dim source As Word.Range
Set source = doc1.Content
Set destination = doc2.Content
destination.Collapse Direction:=Word.wdCollapseEnd
destination.FormattedText = source
Here is the whole module for reference:
Option Explicit
Sub AddDocs()
Dim wordWasRunning As Boolean
wordWasRunning = IsMSWordRunning()
Dim mswApp As Word.Application
Set mswApp = AttachToMSWordApplication()
Dim doc1 As Word.Document
Dim doc2 As Word.Document
Set doc1 = mswApp.Documents.Open("C:\Temp\combined.docx")
Set doc2 = mswApp.Documents.Open("C:\Temp\control.docx")
Dim destination As Word.Range
Dim source As Word.Range
Set source = doc1.Content
Set destination = doc2.Content
destination.Collapse Direction:=Word.wdCollapseEnd
destination.FormattedText = source
doc2.Close SaveChanges:=True
doc1.Close
If Not wordWasRunning Then
mswApp.Quit
End If
End Sub
Here's the promised note on a couple functions I use in the sample. I've built up a set of library functions, several of which help me access other Office applications. I save these modules as .bas files (by using the Export function in the VBA Editor) and import them as needed. So if you'd like to use it, just save the code below in using a plain text editor (NOT in the VBA Editor!), then import that file into your project.
Suggested filename is Lib_MSWordSupport.bas:
Attribute VB_Name = "Lib_MSWordSupport"
Attribute VB_Description = "Variety of support functions operating on MS Word"
Option Explicit
Public Function IsMSWordRunning() As Boolean
Attribute IsMSWordRunning.VB_Description = "quick check to see if an instance of MS Word is running"
'--- quick check to see if an instance of MS Word is running
Dim msApp As Object
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- not running
IsMSWordRunning = False
Else
'--- running
IsMSWordRunning = True
End If
End Function
Public Function AttachToMSWordApplication() As Word.Application
Attribute AttachToMSWordApplication.VB_Description = "finds an existing and running instance of MS Word, or starts the application if one is not already running"
'--- finds an existing and running instance of MS Word, or starts
' the application if one is not already running
Dim msApp As Word.Application
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- we have to start one
' an exception will be raised if the application is not installed
Set msApp = CreateObject("Word.Application")
End If
Set AttachToMSWordApplication = msApp
End Function
I tried since more days to create a Word Document with Excel-VBA
Step by Step:
first: create Word-Document and add a Table (Mailing-Label)
second: fill sometext into some cells. Works great!
Now my Problem:
at last, i want to append an Picture in the cell.
My Problem is, the Image RANGE clear the old text.
And i don't know, how to set the Image and the text at the end of the Loop.
My code
oDoc.Tables(1).Cell(zeile, spalte).Range.Text = "some string"
oDoc.Tables(1).Cell(zeile, spalte).Range.InlineShapes.AddPicture path_to_image
The way to understand what's happening is to think about how this would work if you were doing this manually, working with a selection. When you assign text to a Range that's like typing it in, as you'd expect. The second line of code, inserting the image, is like selecting the entire cell (in this case) then inserting the image: it replaces what's in the Range. When working manually, if you had selected the entire cell, you'd press Right Arrow or click at the end to put the focus after what had been typed.
The same principle applies when using a Range object: it needs to collapse in order to add something to it.
The following code example demonstrates this. It also highlights how the code can be made more efficient by assigning the table and the target range to objects.
Dim tbl As Word.Table 'or As Object if using late-binding
Dim rng As Word.Range 'or As Object if using late-binding
Dim chrCount As Long
Set tbl = oDoc.Tables(1)
Set rng = tbl.Cell(zeile, spalte).Range
rng.Text = "test"
chrCount = rng.Characters.Count
'Get the end of the cell content
Set rng = rng.Characters(chrCount - 1)
rng.Collapse wdCollapseEnd
rng.InlineShapes.AddPicture path_to_image
May be something like
Sub Test()
Dim Wrd As Word.Application
Dim oDoc As Word.Document
Set Wrd = CreateObject("Word.Application")
Wrd.Visible = True
Set oDoc = Wrd.Documents.Add
oDoc.Tables.Add oDoc.Range, 3, 3
zeile = 2
spalte = 2
path_to_image = "C:\Users\user\Desktop\Pull2.jpg"
oDoc.Tables(1).Cell(zeile, spalte).Range.Select
With Wrd.Selection
.TypeText Text:="some string"
.InlineShapes.AddPicture path_to_image
End With
End Sub
I found VBA code and modified it but it didn't work.
Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim i As Integer
Dim j As Integer
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename()
j = 1
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
For i = 1 To .Tables.Count
With .Tables(i)
'copy cell contents from Word table cells to Excel cells
For iRow = 2 To .Rows.Count
For iCol = 1 To .Columns.Count
Cells(j, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
j = j + 1
Next iRow
End With
Next i 'Next Table
End With 'End of the document
Set wdDoc = Nothing
End Sub
I have a Word document, with 750 pages, with a table on each page. I want to import the contents of the tables into an Excel file (with the exception of the first line of each table as that is the column names).
It throws an error (As shown in picture) -- Automation Error -- "Run-time Error 2147418105 (80010007)".
From your screenshot it appears you got through row 10 and started row 11 before the error occurred. Without seeing the full document or knowing the table schema I would try one or more of the following approaches:
Try setting breakpoint before word crashes, then step through to see if specific data or some other issue may be the culprit. (At the Row loop (For iRow = 2 To .Rows.Count) or add IF iRow=10 THEN debug.break then step into each line (Debug>Step Into (F8)) from there.).
If table ends near 10 rows then try closing wdDoc (Set wdDoc = Nothing), reopen, and continue import starting right where you left off. This sounds impractical, but if it works around the bug then you can try adjusting some values and narrowing down the root cause.
Run this VBA on a computer that has lots of free RAM. MS Word may be loading entire 750-page document into memory, then hitting OutOfMemory, pagefile thrashing, or other OS resource limit that devolves into app crash.
Try splitting the 750-page document into 8 files with no more than 100 pages per file. Then loop through each. If that works then look into computer resource limits or issue with Word size limitations.
FYI: I've seen some issues with Word stability at ~1000 pages but I had lots of screenshots and other formatting goodies in that example (and I found solution that kept it split into 27 separate reference detail-level sections with an overall <50-page top-level document loosely referring to them.)
A Year late and short of a known fix, but this debugging checklist might help you or others who stumble upon this thread :-). I'm working with very similar routine (and just started searching for how to pull statistics for each table :-)). Cheers and good luck!