Creating Word document from Excel through VBA - excel

Folks. I have an Excel file and want to create a Word document with the data in a sheet. The program shows an error and I can't find the reason.
I tried to use the following code:
Private Sub CommandButton1_Click()
' Objetos Word
Dim obj1 As New Application
Dim wdDoc As Word.Document
' Objetos Excel
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim Caminho, Arquivo, Nome_aluno, Ender As String
Dim Gen_p, Gen_a, Hora, Prof, Resp As String
Dim i, Comp As Integer
Dim Coord_C As Integer
Dim Coord_L As Integer
Caminho = "D:\Data\Office\Excel\"
Arquivo = "Anexo D - Ata de defesa TCC.docx"
The code continues, but is irrelevant for now.
The point is when I run the code I get the message:
User defined type not defined
This is weird, because in another Excel file I can run it, and it works fine.
What have I missed? Do I have to link something?

To create a new Word doc from another application, add this...
Dim appWD As Word.Application
Set appWD = CreateObject("Word.Application")
appWD.Documents.Add
https://learn.microsoft.com/en-us/office/vba/excel/concepts/working-with-other-applications/controlling-one-microsoft-office-application-from-another

since your code uses:
Dim obj1 As New Application
You must set a VBA reference to whatever application (Word?) obj1 relates to. That is done via Tools|References. You must also tell VBA what application that is. For example:
Dim obj1 As New Word.Application

Related

activex component can't create object 429 excel vba

I have a code in VBA that allows me to control the GUI of a software, I can run the code on my personal computer. I have tried running the same code on other computers but this message shows up: "Run-time error 429" ActiveX component can't create object.
Here is my code up to the line where the message shows up:
Sub GetAllFileNames()
Dim FileName As String
Dim strDirectory As String
Dim path As String
Dim index As Integer
Dim Block As Integer
Dim boot As Integer
Dim week As Integer
Dim Coor_x As Variant
Dim Coor_y As Variant
Dim East(1 To 5) As Variant
Dim North(1 To 5) As Variant
Dim i As Integer
Dim Factory As Rvea0334.Rvea0334Classes
Dim Workspace As IWaspWorkspace
Dim Project As IWaspProject
Set Factory = New Rvea0334Classes '(here I have the problem)
Rvea0334 is already available in References
Thanks in advance for your help

Open two existing word files from excel

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!

Copying all content in OLEObject including header footer with format into new Word.Document/Word.Application

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
.

How to use OpenOffice Spreadsheet to get an image from an excel file

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!

Object Required - error 424 MS ACCESS 2010

I'm really new at VBA but I have this same code in another database, and now I've just copied the code and paste in another database but I get this Object Required error in the last line.
The code is bigger but I've just stopped on the line where I get the error.
Dim frm As Form, ctl As Control
Dim varItm As Variant
Dim stgMO, stgPID, stMail, stgMailCC As String
Dim Question As Long
Dim OutApp, OutMail As Object
Set frm = Forms!Overview
Set ctl = frm!cl_onboarding
stgMO = ctl.Column(7)
stgPID = ctl.Column(2)
stgMail = ctl.Column(8)
stgMailCC = ctl.Column(9)
Question = MsgBox("Do you want to send an e-mail containing the codes for this Agent?", vbYesNo, "Send e-mail")
If Question = vbYes Then
Set OutApp = Outlook.Application
you have dim stMail as a variable but then you use stgMail. just check your spelling.
You also use dim question as long, this confuses me a bit because I thought long meant an integer (there are min and max values but I cant remember).
You need to set a Reference in VBA to Outlook.
VBA editor -> menu Tools -> References
Select and check Microsoft Outlook 14.0 Object Library
Edit: while the above is true, you would probably get a different error if the reference was missing.
The problem may be in this line:
Dim OutApp, OutMail As Object
which actually gets evaluated as
Dim OutApp As Variant, OutMail As Object
and should read
Dim OutApp As Object, OutMail As Object
But a Variant can hold an object too, so this may also not be the cause of the error.

Resources