Edit XML through Excel VBA - excel

I need to update a "simple" XML file with new values and save with a new name.
For a test I am only trying to update one value.
But using the code below I get an error:
Run-time error '91': Object variable or With block variable not set
VBA:
Sub XMLTest()
Dim myVar As String, pathToXML As String
Dim xmlDoc As Object, xmlRoot As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
pathToXML = "C:\Users\Path_to_XML\PJMeasurements.xml" '<--- Update path
Call xmlDoc.Load(pathToXML)
Set xmlRoot = xmlDoc.getElementsByTagName("ns0:MeasurementsSO").Item(0) '<--- Is this correct?
myVar = "9999-9999999" '<--- Update value
xmlRoot.SelectSingleNode("SalesOrderNo").Text = myVar
Call xmlDoc.Save(pathToXML)
End Sub
This is the XML:
<ns0:MeasurementsSO xmlns:ns0="http://update.DocumentTypes.Schema.PJ Measurement.Xml">
<SalesOrderNo>23482-4612310</SalesOrderNo>
<Weight>83</Weight>
<Volume>0,03</Volume>
<Numberofcolli>1</Numberofcolli>
</ns0:MeasurementsSO>

You need to add namespace:
Sub XMLTest()
Dim myVar As String, pathToXML As String
Dim xmlDoc As Object, xmlNode As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
pathToXML = "C:\Temp\PJMeasurements.xml" '<--- Update path
xmlDoc.setProperty "SelectionNamespaces", "xmlns:ns0='http://update.DocumentTypes.Schema.PJMeasurement.Xml'"
Call xmlDoc.Load(pathToXML)
Set xmlNode = xmlDoc.SelectSingleNode("/ns0:MeasurementsSO/SalesOrderNo")
myVar = "9999-9999999" '<--- Update value
xmlNode.Text = myVar
Call xmlDoc.Save(pathToXML)
End Sub

Found the error my self.
GetElementsByTagName was wrong.
Updated above.

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

'Compile Error' - 'Object required' VBA Code

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.

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.

Object.Namespace path error

I wrote this code to return some properties from file:
Dim strMTitle As String
Dim objMshell As Object
Dim objMfolder As Object
Dim objMFolderItem As Object
Dim strMpath As String
strMpath = "C:\Users\User1\Desktop\Test4\"
Set objMshell = CreateObject("shell.application")
Set objMfolder = objMshell.Namespace(strMpath)
Set objMFolderItem = objMfolder.ParseName("test2.xlsm")
strMTitle = objMfolder.GetDetailsOf(objMFolderItem, 21)
Debug.Print strMTitle
The problem is that it keeps returning run time error 91 - Object variable with block variable not set. Weirdest thing is that when I "Hardcode" objMfolder with path like this:
Set objMfolder = objMshell.Namespace("C:\Users\User1\Desktop\Test4\") the code works perferct.
I use this path in multiple places in my macro so I would really like to "store" it in strMpath and use it like this:
Set objMfolder = objMshell.Namespace(strMpath)
Please help!
The code seems to work with the string variable if you use early-binding and the Shell32.Shell as below. Also, .GetDetailsOf with a column argument of 21 returns nothing, but 0 returns the file name.
Option Explicit
'Set Reference to Microsoft Shell Controls and Automation
Sub dural()
Dim strMTitle As String
Dim objMshell As Shell32.Shell
Dim objMfolder As Folder
Dim objMFolderItem As FolderItem
Dim strMpath As String
strMpath = "C:\Users\Ron\Desktop\"
Set objMshell = New Shell32.Shell
Set objMfolder = objMshell.Namespace(strMpath)
Set objMFolderItem = objMfolder.ParseName("20161104.csv")
strMTitle = objMfolder.GetDetailsOf(objMFolderItem, 0)
Debug.Print strMTitle
End Sub

Unable to extract value for xml tags

I am a new to vba and have a task to do at hand. I have written some unction but could not debug it properly. I have following string in xml format:
<!--?xml version=""1.0"" encoding=""UTF-8""?-->
<credentials>
<mid>P</mid>
<mpid>Q</mpid>
<accid>R</accid>
<accesskey>S</accesskey>
<secretkey>T</secretkey>
</credentials>
and am trying to extract value corresponding to tag mid, mpid, accid etc.
Here is the subroutine I wrote:
Private Sub ExtractMWSCredentials(Text As String
Set xmldoc = Nothing
DoEvents
Set xmldoc = Get_XML_DOMDocument_Object()
xmldoc.LoadXML (Trim(Text))
Set mId = xmldoc.getElementsByTagName("mid").Item(0).Text
Set mpId = xmldoc.getElementsByTagName("mpid").Item(0).Text
Set accid = xmldoc.getElementsByTagName("accid").Item(0).Text
Set accesskey = xmldoc.getElementsByTagName("accesskey").Item(0).Text
End Sub
Everything is coming out to be empty. Any help appreciated.
I can't even get that code to compile. You don't use the Set keyword to store a non-object value like Text. You could code, for instance,
Set omId = xmldoc.getElementsByTagName("mid").Item(0)
Debug.Print omId.Text
Also, mId is a reserved word so it can't be a variable name. Here's one way you could do it.
Public Sub Extract()
Dim xDoc As MSXML2.DOMDocument60
Dim sMid As String, sMpid As String
Dim sAccid As String, sAccessKey As String
Set xDoc = New MSXML2.DOMDocument60
xDoc.LoadXML "<!--?xml version=""1.0"" encoding=""UTF-8""?-->" & _
"<credentials><mid>P</mid><mpid>Q</mpid><accid>R</accid>" & _
"<accesskey>S</accesskey><secretkey>T</secretkey></credentials>"
sMid = xDoc.getElementsByTagName("mid").Item(0).Text
sMpid = xDoc.getElementsByTagName("mpid").Item(0).Text
sAccid = xDoc.getElementsByTagName("accid").Item(0).Text
sAccessKey = xDoc.getElementsByTagName("accesskey").Item(0).Text
Debug.Print sMid, sMpid, sAccid, sAccessKey
End Sub
I don't use Set because I'm not storing the Item() in a variable, I'm storing the Item().Text in a variable.

Resources