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!
Related
How do I set a range in Word while opening that file with VBA in Excel?
Dim wordApp As Word.Application
Dim wordObject As Word.Document
Dim wordRange As Word.Range
Dim filePath As String
Dim fileName As String
filePath = "C:\Users\"
fileName = "somename.docx"
Set wordApp = CreateObject("Word.Application")
With wordApp
.Visible = True
.Activate
.WindowState = wdWindowStateNormal
End With
Set wordObject = wordApp.Documents.Open(filePath & fileName)
Set wordRange = Documents(fileName).Sections(1).Range
With wordRange
'code
End With
The line causing trouble:
Set wordRange = Documents(fileName).Sections(1).Range
Regardless of the string I put in this returns
4160 runtime error "Bad File Name"
If I use ActiveDocument instead of Documents(), I get
4248 runtime error: "This command is not available because no document is open".
The error persists even after opening multiple unsaved and saved Word docs whilst running the code, only to have the same error message show up.
Set wordRange = Documents(fileName).Sections(1).Range errors because Excel doesn't know what Documents is (or it resolves it to something other than Word.Documents)
To fix that, you'd use (just as you did in the previous line)
Set wordRange = wordApp.Documents(fileName).Sections(1).Range
That said, you've already Set the Document(filepath & filename) to wordObject, so use it:
Set wordRange = wordObject.Sections(1).Range
Also, Excel doesn't know wdWindowStateNormal, so a new Variant variable is created (unless you have Option Explicit, which you should, always) and assigned the default value 0. Which just happens to be the value of Word.wdWindowStateNormal so no harm done, but the code is misleading.
To fix, use
.WindowState = 0 'wdWindowStateNormal
I'm curious about the way you've created the object. Using early binding but instead of creating New Word.Application you use CreateObject
Was this an intentional decision?
What is the benefit?
Recently I manage to make an automation in VBA where the external word file in the same folder as the excel file is been opened and add new content from excel then save as the word file different name. Below the code:
Dim wordapp As Word.Application
Dim wordfile As Word.Document
Set wordapp = New Word.Application
Set wordfile = wordapp.Documents.Open(Application.ActiveWorkbook.Path & "<word file name>")
wordapp.Visible = False
<code to manipulate the word.document to insert value and graph from excel>
wordfile.SaveAs Filename:=Application.ActiveWorkbook.Path & "<new word file name>"
wordapp.Quit
Set wordapp = Nothing
Set wordfile = Nothing
The original external word file is behaving like a template with header and footer and some paragraph.
Because the nature of my project, I need to embedded the external word file into the excel thus turning the external word file into OLEObject in excel file. Even though I manage to open the OLEObject and manipulate the word.document to insert value and graph from excel and save as external word file, the closed OLEObject will also retain the insert value and graph making it not good for use as template.
I come up with this code. Basically to open the OLEObject and copy the content, then create a new word file and paste the content in it so that the OLEObject will not retain any changes:
Dim objSampleReport As OLEObject
Dim wordApp As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document
Set objSampleReport = pgReport.OLEObjects("objSampleReport")
objSampleReport.Verb xlVerbPrimary
Set wordFileEmbed = objSampleReport.Object
Set wordApp = New Word.Application
Set wordFileNew = wordApp.Documents.Add
wordFileEmbed.Content.Copy
wordFileNew.Content.PasteAndFormat
wordFileEmbed.Application.Quit False
<code to manipulate the word.document to insert value and graph from excel using wordApp.selection>
Eventhough I manage to copy the OLEObject and retain the embedded as original intended, the new created word file dont have header footer and the format is wrong.
So I try to record the copypaste behaviour using Word Macro and this is come up:
Selection.WholeStory
Selection.Copy
Windows("Document1").Activate
Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
With this new knowlegde I try to come up something similar as above. This is the code:
Dim objSampleReport As OLEObject
Dim wordAppEmbed As Word.Application
Dim wordAppNew As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document
Set objSampleReport = pgReport.OLEObjects("objSampleReport")
objSampleReport.Verb xlVerbPrimary
Set wordAppEmbed = objSampleReport.Object.Application
Set wordAppNew = New Word.Application
Set wordFileNew = wordAppNew.Documents.Add
wordAppEmbed.Activate
wordAppEmbed.Selection.WholeStory
wordAppEmbed.Selection.Copy
wordAppNew.Activate
wordAppNew.Selection.PasteAndFormat
wordAppEmbed.Quit False
<code to manipulate the word.document to insert value and graph from excel using wordApp.selection>
But this still result in header footer not been copy paste and the format still wrong. I try to play around with .PasteAndFormat type parameter but the result are still the same.
Can someone help me with this problem? My other option is to use the template as external word file and using the first code but that require me to send excel file and word file at the same time, and human error can occur if the user only copying the excel file.
May try Something in line with following code
Sub NewTest()
Dim objSampleReport As OLEObject
Dim wordAppEmbed As Word.Application
'Dim wordAppNew As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document
Dim pgReport As Worksheet
Set pgReport = ThisWorkbook.Sheets("Sheet1") 'Used for test purpose. May Use your choice
Set objSampleReport = pgReport.OLEObjects("Object 2") 'Used for test purpose. Use use choice
objSampleReport.Verb xlOpen
Set wordAppEmbed = objSampleReport.Object.Application
Set wordFileEmbed = wordAppEmbed.ActiveDocument
Set wordFileNew = wordAppEmbed.Documents.Add
wordFileEmbed.Content.Copy
wordFileNew.Range.Paste
wordFileEmbed.Close
' Now may Work with wordFileNew for further processing New file
End Sub
Edit As suggested by #Cindy Meister's expert opinion and valuable comment, I also feel first saving the embedded document as a new file, then open that document is far more prudent option. My last code is just an attempt to make your code work and tested on simple template only. (It may fail with complex documents). Therefore, I am posting modified code in line with #Cindy Meister's comment
Sub NewTest2()
Dim objSampleReport As OLEObject
Dim wordAppEmbed As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document
Dim pgReport As Worksheet, Fname As String
Set pgReport = ThisWorkbook.Sheets("Sheet1") 'Modify to your choice
Fname = "C:\users\user\Desktop\Test2.docx" 'Modify to your choice
Set objSampleReport = pgReport.OLEObjects("Object 2") 'Used for test purpose. May modify to your choice
objSampleReport.Verb xlOpen
Set wordAppEmbed = objSampleReport.Object.Application
Set wordFileEmbed = wordAppEmbed.ActiveDocument
wordFileEmbed.SaveAs Fname
wordFileEmbed.Close
Set wordFileNew = wordAppEmbed.Documents.Open(Fname)
' Now may Work with wordFileNew for further processing New file
End Sub
.
I want to open and read paragraphs of a Word document from an Excel macro. Here's the sample code that confuses me:
Sub example()
Dim docPath
docPath = "C:\temp\test.docx"
Dim wordApp
Set wordApp = CreateObject("Word.Application")
Dim doc
doc = wordApp.Documents.Open(docPath)
MsgBox (TypeName(doc)) 'This line displays String. According to the documentation it should be a Document.
End Sub
According to the documentation the Documents.Open method should return a Document that you can operate on. But when I check the type it says it has returned a String. Obviously I can't loop through the paragraphs of a string:
https://msdn.microsoft.com/en-us/vba/word-vba/articles/documents-open-method-word
Is the documentation wrong? Am I doing something wrong? More importantly, how do I loop through the paragraphs of a Word document from an Excel macro?
I'm using Office 365 if that matters and I have created a small Word document at C:\temp\test.docx.
try:
Set doc = wordApp.Documents.Open(docPath)
The String you are getting is some property of the Object you have created; might be the Name of the Object.................insert MsgBox doc to see what it is.
Although basically what is missing is a 'Set Doc = ...' you are guaranteed to get into trouble with a code like that. To prevent that some suggestions and a starter code (your code really, a little bit modified):
Add Word object reference from Tools\References and "type" your objects. Typing them would make it much easier to write code with intellisense support.
Never ever let the word object hang out there. Get rid of it when you are done.
Sample:
Dim docPath
docPath = "C:\temp\test.docx"
Dim wordApp As Word.Application
Set wordApp = CreateObject("Word.Application")
Dim doc As Word.Document
Set doc = wordApp.Documents.Open(docPath)
For i = 1 To doc.Paragraphs.Count
Cells(i, 1) = doc.Paragraphs(i).Range.Words.Count
Cells(i, 2) = doc.Paragraphs(i)
Next
wordApp.Quit
Set doc = Nothing
Set wordApp = Nothing
I have a code that exports image from excel into a picturebox and here it is.
Dim appExcel As Object
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = False
Dim xlsBook As New excel.Workbook
Dim xlsSheet As New excel.Worksheet
Dim rowlocation As Integer
Dim columnlocation As Integer
Dim celladdress As String
Set xlsBook = appExcel.Workbooks.Open(Text1.Text)
Set xlsSheet = xlsBook.Worksheets("Sheet1")
Dim x As excel.Shapes
For Each x In xlsSheet.Shapes
x.Copy
Picture1.Picture = Clipboard.GetData(vbCFBitmap)
Text2.Text = x.Name
rowlocation = x.TopLeftCell.Row
columnlocation = x.TopLeftCell.Column
celladdress = xlsSheet.Cells(x.BottomRightCell.Row + 1, x.TopLeftCell.Column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
MsgBox ActiveSheet.Range(celladdress)
Next
End If
and unfortunately this code wont work on my friends PC becuase he does not have an Excel installed but he has OpenOffice spreadsheet. I tried to open the Excel in Openoffice then the file opens now my goal is how can i convert the code above in OpenOffice? I mean run the code for OpenOffice files.
This is my code but its not working
Dim objServiceManager As Object
Dim objDesktop As Object
Dim objDocument As Object
Dim objText As Object
Dim objCursor As Object
Dim oDoc As Object
Dim ARG()
Dim oGraph As Object
Dim oView As Object
Dim oDrawPage As Object
Dim oSheet As Object
Dim Image As System_Drawing.Image
Dim oimage As Object
Dim osize As Object
Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
Set oDoc = objDesktop.loadComponentFromURL("file:///C:\Users\paul\Desktop\Testing.ods", "_blank", 0, ARG())
Set oSheet = oDoc.getSheets().getByIndex(0)
Set oGraph = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
Set oView = oDoc.CurrentController
Set oDrawPage = oView.getActiveSheet.DrawPage
For i = 0 To 2
For j = 0 To 9
' Form1.Image1.Picture = Clipboard.GetData
Form1.Image1.Picture = LoadPicture(oDrawPage)
Next
Next
TYSM for future help
This is the latest code in VB6 and it has an error saying vnd.sun.star is missing
Dim objServiceManager As Object
Dim objDesktop As Object
Dim objDocument As Object
Dim objText As Object
Dim objCursor As Object
Dim oDoc As Object
Dim ARG()
Dim oGraph As Object
Dim oView As Object
Dim oDrawPage As Object
Dim oSheet As Object
Dim Image As System_Drawing.Image
Dim oimage As Object
Dim osize As Object
Dim Cell As Object
Dim sGraphicUrl As String
Dim oDisp
Dim oFrame
Dim opos As Object
Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
Set osize = objServiceManager.Bridge_GetStruct("com.sun.star.awt.Size")
Set opos = objServiceManager.Bridge_GetStruct("com.sun.star.awt.Point")
Set oDoc = objDesktop.loadComponentFromURL("file:///C:\Users\paul\Desktop\ACE Express - Fairview_Sample PC of Gondola.ods", "_blank", 0, ARG())
Set oSheet = oDoc.getSheets().getByIndex(0)
Set oimage = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
Set oView = oDoc.CurrentController
Set oDrawPage = oView.getActiveSheet.DrawPage
Set oimage = oDrawPage.getByIndex(0)
Image1.Picture = LoadPicture(oimage.GraphicURL)
Here is the output of the unzip picture
I do not know exactly what your code does, because I normally do not use Microsoft Office. However it looks like this task can be accomplished using OpenOffice Basic. One of the best places to learn OpenOffice Basic is Andrew Pitonyak's Macro Document.
To start with, look at section 5.9.5. Convert all linked images.
EDIT:
To do this in Calc, first I went to Tools -> Macros -> Organize Dialogs and created a dialog named "ImageViewerForm" with an image control named "MyImageControl".
Then I went to Tools -> Macros -> Organize Macros -> OpenOffice Basic and added the following code:
Sub ShowImageViewerDialog
oDoc = ThisComponent
oDlg = CreateUnoDialog(DialogLibraries.Standard.ImageViewerForm)
oControl = oDlg.Model.MyImageControl
oDrawPage = oDoc.getDrawPages().getByIndex(0)
oImage = oDrawPage.getByIndex(0)
oControl.ImageURL = oImage.GraphicURL
oDlg.execute()
End Sub
To run the code, go to Tools -> Macros -> Run Macro. Here is the result:
The "Next Image" button should be fairly straightforward to implement by adding an event handler.
For documentation, see GraphicObjectShape and UnoControlButtonModel. But mostly I just used the MRI tool to figure it out.
EDIT 2:
Regarding the error you posted, the GraphicURL property in this case is a string that references an in-memory object, not a filepath. An example of the string is shown here: https://www.openoffice.org/api/docs/common/ref/com/sun/star/graphic/XGraphicObject.html.
So it is not suitable for passing to LoadPicture, which takes a filename.
Perhaps you can get the actual image data from oImage.Bitmap or oImage.Graphic. Use MRI to see what attributes are available.
For example, it looks like there is a getDIB() method that might work like this:
Form1.Image1.Picture = oImage.Bitmap.getDIB()
One more idea: Instead of using an Office application, you could write code that unzips the file and reads each image in the Pictures subdirectory.
I have never tried it but according to the docs you can control Open Office through COM automation.
Your VB6 code above is controlling Excel through COM automation. You could install Open Office on your machine, and see whether you can automate Calc from VB6 to open a spreadsheet and extract an image. I don't know whether it allows that. Excel COM automation is very powerful and allows you to do almost anything, Open Office may not be as powerful (I don't know).
I would advise thinking carefully about what problem you are trying to solve and whether there's another approach entirely!
I'm trying to search an MS Word doc for embedded Excel files and save them to a different location.
1) I want to record the page number and or section name (based on header style) the embedded file was located in the Word Doc. How can I extract this info?
2) Is there anyway to get the original filename of the embedded Excel file?
Here is the code I'm using to search for embedded files. Originally
Working off the code first presented here: Extract Embeded Excel Workseet Data
Sub TestMacro2()
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Dim lNumShapes As Long
Dim lShapeCnt As Long
Dim xlApp As Object
Dim wrdActDoc As Document
Dim iRow As Integer
Dim iCol As Integer
Set wrdActDoc = ActiveDocument
For lShapeCnt = 1 To wrdActDoc.InlineShapes.Count
If wrdActDoc.InlineShapes(lShapeCnt).Type = wdInlineShapeEmbeddedOLEObject Then
If wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.ProgID = "Excel.Sheet.8" Then
wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.Edit
Set xlApp = GetObject(, "Excel.Application")
cpath = "location of interest"
xlApp.Workbooks(1).SaveAs cpath & " " & lShapeCnt
xlApp.Workbooks(1).Close
xlApp.Quit
Set xlApp = Nothing
End If
End If
Next lShapeCnt
End Sub
Note: Your code would be more efficient (and easier to read) if you assign an object that's re-used to a variable:
Dim ils as Word.InlineShape
Set ils = wrdActDoc.InlineShapes(lShapeCnt)
(1) The Range.Information method can return the page number. Something like:
Dim pageNumber as Long
pageNumber = ils.Range.Information(wdwdActiveEndPageNumber)
The other option is not as straight forward... I expect you really mean Heading style, not Header style. There is a built-in bookmark that will get the Heading preceding the current selection. That would be something like:
Dim secName as String
ils.Range.Select
secName = ActiveDocument.Bookmarks("\HeadingLevel").Range.Text
(2) If the file is not linked then your chances are slim. There's nothing VBA can get at directly, that's certain. Possibly, something might be stored in the WordOpenXML. You can check that by downloading the Open XML SDK Productivity Tool, opening such a document in it and inspecting that part of the Open XML. If it's in there then you can get at it in VBA using ils.Range.WordOpenXML to get the Open XML for the InlineShape, then parse that.