'Compile Error' - 'Object required' VBA Code - excel

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.

Related

VBA - Unexpected ObjectType leading to error

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

Not able to call second macro after first macro is generated

I have a few subs that works perfectly fine individually. However when I put few subs together to be called in one sub, it won't run properly. After first sub is called and generated, the second sub won't run and came out an error. I just don't get it how it won't run, please anyone tell me where went wrong. I tried adjusting the codes but it won't work.
Mail merge won't work for my project as I have thousands of data to be generated. Thank you in advance.
This sub below is to call sub test1 and test2 and came out an error
Sub callsubs()
test1
test2
End Sub
Here is my sub test1 and test2 is the same as test1 so I won't be putting it again.
Option Explicit
Const FilePath As String = "Z:\PJ General\Staff\Admin Dept\Ching Lu\AP LOAN v3 Test\Correspondences\"
Dim wd As New Word.Application
Sub Copy2word(bookmarkName As String, Text2Type As String)
'copy each cell to relevant Word bookmark
wd.Selection.GoTo What:=wdGoToBookmark, Name:=bookmarkName
wd.Selection.TypeText Text2Type
End Sub
Sub test1()
Dim doc As Object
Set doc = CreateObject("Word.Application")
Dim strName As String
strName = Sheet15.Range("C67")
wd.Visible = True
Dim dev_attn As String
Set doc = wd.Documents.Open(FilePath & "Step 2a LBS-LPPSA.doc", ReadOnly:=True)
doc.Unprotect Password:="stwppj312"
With wd.ActiveDocument
dev_attn = ThisWorkbook.Sheets("Data Entry B").Range("C809").Value
Copy2word "dev_attn", dev_attn
Call devref
Call stwpref
doc.SaveAs Filename:="C:\Users\" & Environ$("username") & "\Downloads\" & "Step2a " & strName & ".doc"
End With
wd.Quit
Set doc = Nothing
End Sub
In the code, you create the Word application object several times - once via Dim wd As New Word.Application (early binding; the instance is assigned to the global variable wd), and every time you run test1() and test2() via Set doc = CreateObject("Word.Application") (late binding; the instance is assigned to the local variable doc). At the end of each test1() and test2() procedure, you destroy the global wd instance via wd.Quit. So by running test1() and test2() procedures sequentially, after the first one finishes, the wd object (which you access, for example in wd.Visible = True) will no longer be bound to the Word.Application instance, hence the error.
Creating multiple instances of "Word.Application" is time-consuming and resource-intensive, so I recommend creating such an object once and using it in all procedures, and removing it when done. Accordingly, don't create a local instance of "Word.Application" inside each of test1() and test2() procedures, but use only the global one.
Dim wd As New Word.Application
...
Sub callsubs()
test1 ' without wd.Quit, without Set doc = CreateObject("Word.Application")
test2 ' without wd.Quit, without Set doc = CreateObject("Word.Application")
wd.Quit
End Sub
In addition, the command Set doc = CreateObject("Word.Application") in your procedures creates a local instance of "Word.Application" that is not used at all, but wastes time and resources. This happens as follows:
Set doc = CreateObject("Word.Application") ' a new instance of the "Word.Application" is created and bound with doc variable
...
Set doc = wd.Documents.Open(FilePath & "Step 2a LBS-LPPSA.doc", ReadOnly:=True) ' doc variable re-binding with opened Document
...
'The "Word.Application" instance hasn't been destroyed, it still lives in memory (see Task Manager, section Background Processes)
I recommend you remove the line Set doc = CreateObject("Word.Application")
It looks to me like the problem is that you've created your wd object as a global variable that you then quit in Test1. This will cause Test2 to have no wd to reference.
I would bring the wd declaration into the Test1 and Test2 and then pass it to Copy2word as a parameter instead. Something like this:
Sub Copy2word(bookmarkName As String, Text2Type As String, wd As Word.Application)
[Same code]
End Sub
Sub test1()
Dim wd As New Word.Application
...
Copy2word "dev_attn", dev_attn, wd
...
End Sub

Setting range in Word with VBA in Excel

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?

Reference custom layout in PowerPoint from Excel by name

I'm in Excel and I'd like to reference a custom layout for a slide in PowerPoint by name. You can only refer to them by index, so I thought a function should do the trick:
Sub Monatsbericht()
Dim DestinationPPT As String
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Set PowerPointApp = New PowerPoint.Application
DestinationPPT = "C:\VBA\Reports\MonthlyReport_Template.pptm"
Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)
Debug.Print PPLayout("CLayout1")
'Rest of code
End Sub
Function PPLayout(clayout As String)
Dim myPresentation As PowerPoint.Presentation
Dim olay As PowerPoint.CustomLayout
For Each olay In ActivePresentation.SlideMaster.CustomLayouts
If olay.Name = clayout Then
PPLayout = olay.Index
Exit Function
End If
Next olay
End Function
I get error 429: "Object creation by Activex component not possible.", highlighting the for each line in the function.
Actually ActivePresentation should be myPresentation, Excel should not know the ActivePresentation. Also you must submit myPresentation as a parameter otherwise this is an empty variable in your function.
If you have a look at the Slides.AddSlide method (PowerPoint) you see that the second parameter is not an index but of type CustomLayout so your function must return the layout instead of an index.
Public Function PPLayout(clayout As String, myPresentation As PowerPoint.Presentation) As PowerPoint.CustomLayout
Dim olay As PowerPoint.CustomLayout
For Each olay In myPresentation.SlideMaster.CustomLayouts
If olay.Name = clayout Then
Set PPLayout = olay
Exit Function
End If
Next olay
End Function
And use it like
Debug.Print PPLayout("CLayout1", myPresentation).Index
or
myPresentation.Slides.AddSlide(myPresentation.Slides.Count + 1, PPLayout("CLayout1", myPresentation))

Error-Is Nothing condition in case of object

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.

Resources