my code is below. narDocument is throwing on error on
narDocument.Quit False
The error is "Runtime Error 438: Object doesn't support this object or method"
When I check the object type of narDocument, it's type 8, which is a String.
So it makes sense that an object of type String wouldn't have the method .Quit, but my question is - why is this a String in the first place? I can't see where it's actually assigned to being a String, and all the rest of the code works as intended... which I think would be the case if this was indeed a String. Thanks!
Public Sub testing_1()
Dim narApplication As Word.Application
Dim narDocument As Word.Document
Set narApplication = CreateObject("word.application")
Set narDocument = narApplication.Documents.Open(ThisWorkbook.Path & "/document_template.docx")
MsgBox VarType(narDocument)
Dim TITLE As String
Dim myRange As Word.range
Dim myFind As Word.Find
Dim filePath As String
TITLE = range("B1")
'For each value, find it's value in the blankdocument
Set myRange = narDocument.Content
Set myFind = myRange.Find
With myFind
.Text = "__TITLE__"
searchResult = .Execute
End With
MsgBox VarType(narDocument)
narDocument.Hyperlinks.Add Anchor:=myRange, Address:="http://www.google.com", TextToDisplay:=TITLE
filePath = ThisWorkbook.Path & "/document_test.docx"
narDocument.SaveAs2 Filename:=filePath
MsgBox VarType(narDocument)
' Cleanup
narDocument.Quit False
Set narApplication = Nothing
Set narDocument = Nothing
End Sub
You get 8 from VarType as the default property of a Document object is its Name property which returns a String.
Assuming you want to close the Document without saving and then quit Word, amend your line
narDocument.Quit False
to
narDocument.Close False
narApplication.Quit
Related
Hello I am trying to use vba to read the field names of a pdf form. But the obstacle is whenever I try to run the code, it returns this error
click here to preview the error message
**Run time error : "-2147319322 (800280rb)
Automation Error, Element no found**
Extra Note:
I have installed Adobe Acrobat Pro
I have made references to the required libraries: AFormOut 1.0 Type Library and Adobe Acrobat 10.0 Type Library.
link to the screen capture of the referred libraries
Here is my code:
Sub read_pdf_form_fields()
Dim aApp As Acrobat.AcroApp
Dim avdoc As Acrobat.AcroAVDoc
Dim pdfformfile As String
Dim pdf_form As AFORMAUTLib.AFormApp
Dim pdf_form_flds As AFORMAUTLib.Fields
Dim pdf_form_fld As AFORMAUTLib.Field
Dim pdf_form_file As String
Set aApp = CreateObject("AcroExch.App")
Set avdoc = CreateObject("AcroExch.AVDoc")
If avdoc.Open(Range("directory").Value, "") = True
'MsgBox True
avdoc.BringToFront
aApp.Hide
Set pdf_form = CreateObject("AFORMAUT.App")
Set pdf_form_flds = pdf_form.Fields
For Each pdf_form_fld In pdf_form_flds 'the error happens here
With pdf_form_fld
Debug.Print .Name & "| " & .Type & " |" & .Value
End With
Next pdf_form_fld
Else
Debug.Print False
End If
aApp.Exit
Set aApp = Nothing
Set avdoc = Nothing
End Sub
Can anybody help me solve this problem?
Thank you
It look like you are missing a "then" here If
If avdoc.Open(Range("directory").Value, "") = True
should be
If avdoc.Open(Range("directory").Value, "") = True Then
EDIT: also Range("directory").Value from what you have provided, is nothing as to my knowledge, Range needs to
A. have a cell reference i.e. Range("A1")
or
B. refer to a Dim like so
Dim directory As Integer'//idk what Var type you are intending to use
Range("A" & directory)
I have been creating a macro in excel that will pull information from an excel sheet and insert into a word document.
After much trial and error I have managed to get it to insert all the information I want but I am now stuck on changing the formatting of what is inserted.
After trying a number of different ways to change the formatting inside the macro (none of which worked) I settled on creating a number of functions in word VBA to make the formatting changes I wanted (I.E Change to a style, bold or format to bullet points). These functions work in word with zero problems. But whenever I call them from the excel macro I get a Run-time error '438' Object doesn't support this property or method. I double and triple checked I have the word object library ticked, at this stage I'm assuming I'm doing something an excel object doesn't like but for the life of me I can not figure out where the issues is.
Here is a small section of the excel macro, if I run it without calling the word function it works fine. I have tried putting the call inside a with wrdApp with no luck. I also tried pulling it outside of the with wrdDoc but that didn't work either.
Sub ExportData()
'
' ExportData Macro
' Export the data from excel into a more usable form in word
'
Dim sheetcounter As Integer
Dim counter As Integer
Dim numbsheets As Integer
Dim numbepisodes As Integer
Dim wrdApp As Object, wrdDoc As Object
Dim episodetitle As String
Dim nextepisodetitle As String
Dim season As Variant
Dim series As String
Dim episodenumber As String
Dim releasedate As Variant
Dim length As String
Dim fndDay As Integer
Dim fndMnth As Integer
Dim hrs As String
Dim mns As String
Dim scs As String
Dim lnglgth As String
Dim sheetname As String
Dim myRange As Range
Dim lookupRange As Range
Dim datarng As Range
Dim text As Range
Set wrdApp = CreateWord
Set wrdDoc = wrdApp.Documents.Add
With wrdDoc
numbsheets = Application.Sheets.Count
.Content.ParagraphFormat.SpaceBefore = 0
.Content.ParagraphFormat.SpaceAfter = 0
.Content.InsertAfter "Internal Wiki"
Call wrdApp.cntrl("Internal Wiki", "Style", "Title")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
Here is the cntrl word function
Public Function cntrl(txt As String, fnctn As String, optn As String, Optional optnsize As Integer) as Object
'
' A function to control the word functions from excel
'
'
Dim myRange As Range
Set myRange = fndtxt(txt)
If fnctn = "Style" Then
Call Style(myRange, optn)
ElseIf fnctn = "List" Then
Call List(myRange, optn)
ElseIf fnctn = "Format" Then
If IsMissing(optnsize) Then
Call format(myRange, optn)
Else
Call format(myRange, optn, optnsize)
End If
End If
End Function
The fnd txt function
Public Function fndtxt(txt As String) As Range
'
' A function to find text and return it as a range. To be used in combination with the formatting funcitons
'
'
Set fndtxt = ActiveDocument.Range
With fndtxt.Find
.text = txt
.Forward = True
.Execute
End With
End Function
And the style function.
Public Function Style(txt As Range, stylename As String) As Object
'
' A function to apply styles to ranges
'
'
Dim myRange As Range
Set myRange = txt
myRange.Style = stylename
End Function
I split them out into individual functions so I could use them separately if I wanted or together in the control function. I am sure this is not the most efficient way but after working on this for 3 days straight I needed to split things up or I was going to have an aneurism. To be through I tried them as sub's instead of functions and got the same error.
I get the same error for all the formatting functions, I just focused on the style one as this seemed the best way to simplify things and make it easier to explain :). Quite happy to post those as well if required.
Sorry if this has been answered, I had a look through the forums but could not see anything like this.
Would appreciate any and all help this is driving me insane.
EDIT:
Thank you very to much to Tim this is now working, here is the changed and working code. I moved the funcs into excel and you can find them below.
Excel Macro
Sub ExportData()
'
' ExportData Macro
' Export the data from excel into a more usable form in word
'
Dim sheetcounter As Integer
Dim counter As Integer
Dim numbsheets As Integer
Dim numbepisodes As Integer
Dim wrdApp As Object, wrdDoc As Object
Dim episodetitle As String
Dim nextepisodetitle As String
Dim season As Variant
Dim series As String
Dim episodenumber As String
Dim releasedate As Variant
Dim length As String
Dim fndDay As Integer
Dim fndMnth As Integer
Dim hrs As String
Dim mns As String
Dim scs As String
Dim lnglgth As String
Dim sheetname As String
Dim myRange As Range
Dim lookupRange As Range
Dim datarng As Range
Dim text As Range
Set wrdApp = Createword
Set wrdDoc = wrdApp.Documents.Add
With wrdDoc
numbsheets = Application.Sheets.Count
.Content.ParagraphFormat.SpaceBefore = 0
.Content.ParagraphFormat.SpaceAfter = 0
.Content.InsertAfter "DnD is for Nerds Wiki"
Call cntrl(wrdDoc, "DnD is for Nerds Wiki", "Style", "Title")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
The cntrl function
Public Function cntrl(doc As Word.Document, txt As String, fnctn As String, optn As String, Optional optnsize As Integer) As Object
'
' A function to control the word funcitons from excel
'
'
Dim myRange As Word.Range
Set myRange = fndtxt(doc, txt)
If fnctn = "Style" Then
Call Style(myRange, optn)
ElseIf fnctn = "List" Then
Call List(myRange, optn)
ElseIf fnctn = "Format" Then
If IsMissing(optnsize) Then
Call format(myRange, optn)
Else
Call format(myRange, optn, optnsize)
End If
End If
End Function
The fndtxt function
Public Function fndtxt(doc As Word.Document, txt As String) As Word.Range
'
' A function to find text and return it as a range. To be used in combination with the formatting funcitons
'
'
Dim rng As Word.Range
Set rng = doc.Range
With rng.Find
.text = txt
.Forward = True
.Execute
End With
Set fndtxt = rng
End Function
The Style function
Public Function Style(txt As Word.Range, stylename As String) As Object
'
' A function to apply styles to ranges
'
'
Dim myRange As Word.Range
Set myRange = txt
myRange.Style = stylename
End Function
A lot of it came down to adding the word. in front of the ranges.
Here's a basic example with all the code on the Excel side:
Sub Tester()
Dim wdApp As Word.Application, doc As Word.Document, rng As Word.Range
Set wdApp = GetObject(, "Word.Application") 'in my testing word is already open
Set doc = wdApp.Documents.Add()
With doc
.Content.ParagraphFormat.SpaceBefore = 0
.Content.ParagraphFormat.SpaceAfter = 0
.Content.InsertAfter "Internal Wiki"
SetTextStyle doc, "Internal Wiki", "Title"
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
End With
End Sub
Sub SetTextStyle(doc As Word.Document, txt As String, theStyle As String)
Dim rng As Word.Range
Set rng = WordTextRange(doc, txt)
If Not rng Is Nothing Then
rng.style = theStyle
Else
MsgBox "'" & txt & "' was not found", vbExclamation
End If
End Sub
'return a range containing the text `txt` in document `doc`
' returns Nothing if no match is made
Function WordTextRange(doc As Word.Document, txt As String) As Word.Range
Dim rng As Word.Range
Set rng = doc.Range
With rng.Find
.Text = txt
.Forward = True
If .Execute() Then 'check that Execute succeeds...
Set WordTextRange = rng
End If
End With
End Function
I am trying to print a document however I am receiving the error
'Compile Error' - 'Object required'
and then it highlights the line
Set previousPrinter = objWord.ActivePrinter
I am using the following code:
Private Sub CommandButton1_Click()
Dim previousPrinter
Dim objWord As New Word.Application
Set previousPrinter = objWord.ActivePrinter
objWord.ActivePrinter = "Followprint"
On Error GoTo CLOSE_WORD_APP 'error handling to ensure there will not be any orphaned and invisible Word application left
Dim doc As Word.Document
Set doc = objWord.Documents.Open("test.docx")
doc.Variables("refBook").Value = Me.txtRef.Text
doc.Fields.Update
doc.Save
objDoc.PrintOut
' Restore the original printer
objWord.ActivePrinter = previousPrinter
doc.Close
CLOSE_WORD_APP:
objWord.Quit SaveChanges:=False
End Sub
ActivePrinter returns a string with the name of the printer, not an object. Therefore, declare previousPrinter as string and simply assign the result of ActivePrinter to it.
Dim previousPrinter as String
Dim objWord As New Word.Application
previousPrinter = objWord.ActivePrinter
objWord.ActivePrinter = "Followprint"
(...)
In VBA, the keyword Set is only used to assign an object to a variable (eg the result of the Documents.Open-function). If you use it when trying to assign anything that is not an object, the compiler (or the runtime) will throw the Object required error message.
I have been struggling quite a bit with trying to get this to work. I have an Excel workbook that contains information for clients. I want to click a button that runs a macro that takes a word document--a template--and update the fields in the template according to the data stored in the Excel workbook (i.e. I want the "client" custom property field in the template to change its value to "John Smith").
I am able to open the word document fine, and have had some success in updating the fields from word VBA, but I have not been able to get excel vba to update the fields of the word document. The error i get is 4248, ~"no document is open", which occurs at the for loop. If I place the for loop inside the OpenWordDoc, I still get the 4248 error. Any help is appreciated.
Here is the code I have been working with:
Sub GenDraftLetter()
Dim i As Long
Dim j As Double
Dim k As Object
Dim filenam As String
Dim prop As DocumentProperty
Dim oppname As String
Dim clientname As String
Dim objWord As Object
Dim ow As Window
Dim wd As Object
Dim fwd As Object
Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
Set objWord = CreateObject("Word.Application")
End If
i = InputBox("Number of row for the Client", "Row for Client")
j = 1
Do Until Mid(Cells(i, 1), j, 1) = ","
j = j + 1
Loop
clientname = Right(Cells(i, 1), Len(Cells(i, 1)) - j - 1) & " " & Left(Cells(i, 1), j - 1)
filenam = "template.docx"
OpenWordDoc (filenam)
For Each prop In ActiveDocument.CustomDocumentProperties
If LCase(prop.Name) = "client" Then
prop.Value = clientname
Exit For
End If
Next
End Sub
Private Sub OpenWordDoc(filenam)
Dim fullname As String
Dim driv As String
Dim filepat As String
Set wordapp = CreateObject("word.Application")
wordapp.Documents.Open filepat Thisworkbook.Path & "\" & filenam
wordapp.Visible = True
wordapp.Activate
The code in the question has a number of problems. I'll start with the "simple" one, even though it's not the first one.
Excel VBA doesn't "know" ActiveDocument
The following line should be triggering a compile error in Excel VBA, although it will work fine from within Word VBA:
For Each prop In ActiveDocument.CustomDocumentProperties
Excel VBA doesn't have an object ActiveDocument, only Word VBA has this. If the code is running in any environment other than Word VBA, this won't work. The VBA environment needs to be told in which library it can find this object; the Word library needs to be specified using the Application object for Word:
For Each prop In objWord.ActiveDocument.CustomDocumentProperties
Don't use ActiveDocument if at all possible
While ActiveDocument does work, it's not as reliable as working directly with an object. Since this code opens a document, it's possible to assign that document to an object variable when it's opened, then work with the object variable.
As the code in the question uses a separate procedure for opening the document, this can be changed from Sub to Function in order to return the document object.
Documents need to be searched in the same Word instance
In addition, the Word.Application object should be passed to the "open" procedure. The code in the question starts an instance of the Word application in both the first procedure and in the "open" procedure. These are separate instances, so a document opened in the "open" procedure won't be visible to the first procedure. That's the reason for the error reported.
The code can be changed to this (some "Dims" removed for clarity):
Sub GenDraftLetter()
Dim i As Long
Dim j As Double
Dim filenam As String
Dim prop As Variant
Dim clientname As String
Dim objWord As Object
Dim objDoc as Object
Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
Set objWord = CreateObject("Word.Application")
End If
i = InputBox("Number of row for the Client", "Row for Client")
j = 1
Do Until Mid(Cells(i, 1), j, 1) = ","
j = j + 1
Loop
clientname = Right(Cells(i, 1), Len(Cells(i, 1)) - j - 1) & " " & Left(Cells(i, 1), j - 1)
filenam = "template.docx"
Set objDoc = OpenWordDoc(filenam, objWord)
For Each prop In objDoc.CustomDocumentProperties
If LCase(prop.Name) = "client" Then
prop.Value = clientname
Exit For
End If
Next
End Sub
Private Function OpenWordDoc(filenam, objWord) as Object
Dim objDoc as Object
'In case the code is called where no Word object is open
'Can be removed if this is not the intention of this procedure
If objWord Is Nothing Then
Set objWord = GetObject(, "Word.Application")
If objWord Is NOthing Then
Set objWord = CreateObject("Word.Application")
End If
End If
Set objDoc = objWord.Documents.Open(Thisworkbook.Path & "\" & filenam)
Set OpenWordDoc = objDoc
End Function
I am trying to use a conditional code for Object such that if value/text is found in object (in my example it is JSONObject) then do something otherwise nothing. But when I run the code it is working only when found in object and shows "runtime error" when it is not found in object.
The code is:-
Private Sub CommandButton3_Click()
Dim jsonText As String
Dim FSO As New FileSystemObject
Dim JsonTS As TextStream
Dim jsonObject As Object('It is an object created )
myfile = Application.GetOpenFilename(FileFilter:="JSON file (*.json), *.json", Title:="Get File", MultiSelect:=True)
Set JsonTS = FSO.OpenTextFile(myfile, ForReading)
jsonText = JsonTS.ReadAll
JsonTS.Close
Set jsonObject = JsonConverter.ParseJson(jsonText)
' Condition that if in jsonObect, "b2b" is found then
If Not jsonObject("b2b") Is Nothing Then
For Each item In jsonObject("b2b") '("inv")
Sheet3.Cells(a, 2) = jsonObject("fp")
Sheet3.Cells(a, 1) = item("ctin")
End If
End Sub
I'd rather have JSON to test with but you could attempt to set jsonObject("b2b") into a new variable wrapped within an On Error Resume Next and then test that for If Not Is Nothing
Dim b2bObject As Object
Dim item As Variant '<<=== ? missing from your code
On Error Resume Next
Set b2bObject = jsonObject("b2b")
On Error GoTo 0
If Not b2bObject Is Nothing Then
For Each item In b2bObject
Sheet3.Cells(a, 2) = jsonObject("fp")
Sheet3.Cells(a, 1) = item("ctin")
Next
End If
If using in a loop you may wish to Set b2bObject = Nothing before End If as safeguard.