I am trying to replace a found attribute with a new value, but can not seem to get it....
XML Example
<department sysid="1" name="a" minAmt="0.00" maxAmt="0.00" isAllowFS="0" isNegative="0" isFuel="0" isAllowFQ="0" isAllowSD="0" isBL1="0" isBL2="0" isMoneyOrder="0">
<category sysid="0" />
Code
For Each node In xmldoc.SelectNodes("//department")
'For Each node In nodeDepartment
Dim a = node.getAttribute("isFuel").ToString
If a = 0 Then
node.ChildNodes.Item(1).Attributes.getNamedItem("sysid").Value = "400"
Dim sName As String = node.getAttribute("name").ToString 'I get the value here
If Trim(sName) = "" Then
node.Attribute("name") = "A" 'I Error on this line
End If
End If
lCount += 1
Next
You need to use the SetAttribute Method instead of GetAttribute.
If Trim(sName) = "" Then
node.SetAttribute("name", "A")
End If
Related
I'm trying to create a chamfer using pre selected faces in a macro. But i'm no having much sucess
what I have tried:
The faces are previously selected.
chamfer2 = shapeFactory1.AddNewChamfer(reference1, catTangencyChamfer, catLengthAngleChamfer, catNoReverseChamfer, 1, 45.0#)
Dim Num_Faces As Integer = selection1.count
Dim Faces_ref(Num_Faces)
For i = 1 To Num_Faces
Dim MyBRepName = (selection1.Item(i).Value.Name)
MyBRepName = Replace(MyBRepName, "Selection_", "")
MyBRepName = Left(MyBRepName, InStrRev(MyBRepName, "));"))
MyBRepName = MyBRepName + ");WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)"
MsgBox(MyBRepName)
reference1 = Part1.CreateReferenceFromName(MyBRepName)
chamfer1.AddElementToChamfer(reference1)
Next
the error appears here:
chamfer1.AddElementToChamfer(reference1)
Try to remove brackets from reference1 like this:
chamfer1.AddElementToChamfer reference1
I want to test an object to see if it doesn't exist. If it does not exist, I just want to have a MsgBox show up (or write Error in cell A1 or something). Banana does not exist in this XML.
<?xml version="1.0"?>
<catalog>
<book id="Adventure">
<author>Gambardella, Matthew</author>
<title>XML Developer's Guide</title>
<price>44.95</price>
</book>
<book id="Adventure">
<author>Ralls, Kim</author>
<title>Midnight Rain</title>
<price>5.95</price>
</book>
<book id="Adventure">
<author>Boal, John</author>
<title>Mist</title>
<price>15.95</price>
</book>
<book id="Mystery">
<author>Ralls, Kim</author>
<title>Some Mystery Book</title>
<price>9.95</price>
</book>
</catalog>
The test code:
Sub mySub()
Dim XMLFile As Variant
Dim Author As Object
Dim athr As String, BookType As String, Title As String, StoreLocation As String
Dim AuthorArray() As String, BookTypeArray() As String, TitleArray() As String, StoreLocationArray() As String
Dim i As Long, x As Long, j As Long, pn As Object, loc As Object, arr, ln As String, loc2 As Object
Dim mainWorkBook As Workbook
Dim n As IXMLDOMNode
Set mainWorkBook = ActiveWorkbook
Set XMLFile = CreateObject("Microsoft.XMLDOM")
XMLFile.Load ("C:\BooksOriginal.xml")
x = 1
j = 0
Set Author = XMLFile.SelectNodes("/catalog/book/banana")
If Author Is Nothing Then
MsgBox ("Not Found")
Range("A1").Value = "Not found"
End If
If Not Author Is Nothing Then
For i = 0 To (Author.Length - 1)
athr = Author(i).Text
If athr = "Ralls, Kim" Then
Set pn = Author(i).ParentNode
BookType = pn.getAttribute("id")
Title = pn.getElementsByTagName("title").Item(0).nodeTypedValue
AddValue AuthorArray, athr
AddValue BookTypeArray, BookType
AddValue TitleArray, Title
AddValue StoreLocationArray, StoreLocation
j = j + 1
x = x + 1
End If
Next
Range("A3").Resize(j, 1).Value = WorksheetFunction.Transpose(AuthorArray)
Range("B3").Resize(j, 1).Value = WorksheetFunction.Transpose(BookTypeArray)
End If
End Sub
'Utility method - resize an array as needed, and add a new value
Sub AddValue(arr, v)
Dim i As Long
i = -1
On Error Resume Next
i = UBound(arr) + 1
On Error GoTo 0
If i = -1 Then i = 0
ReDim Preserve arr(0 To i)
arr(i) = v
End Sub
Why does this block not do anything? I feel like it's being completely overlooked at by VBA. I even tried putting an End in the If statement.
If Author Is Nothing Then
MsgBox ("Not Found")
Range("A1").Value = "Not found"
End
End If
Also, the error is also thrown at the print range line.. which is in the If Not Author Is Nothing statement. Very strange.
The reason your loop is still executing is simply that If Author Is Nothing evaluates as true. The call to XMLFile.SelectNodes returns an IXMLDOMNodeList, which is an enumerable container. In fact, the reason that it can be used with For Each syntax depends on this. In general, any enumeration returned by a function will give you an enumerable with no items in it rather than a null object. The For Each syntax is equivalent to doing this:
Do While Author.NextNode()
'...
Loop
...or...
For i = 0 To (Author.Length - 1)
'...
Next i
For Each just has the benefit of being more readable.
The error you get actually isn't related to the question you're asking, and correcting the check on the return value of XMLFile.SelectNodes("/catalog/book/banana") won't solve the error if you don't get any results. The error lies in trying to use your arrays after the loop if they aren't instantiated (although the added End would have solved that).
When you exit the loop and get here...
Range("A3").Resize(j, 1).Value = WorksheetFunction.Transpose(AuthorArray)
Range("B3").Resize(j, 1).Value = WorksheetFunction.Transpose(BookTypeArray)
...your AuthorArray and BookTypeArray have only been initialized if you've been through the loop, because you are relying on the ReDim Preserve in the Sub AddValue to initialize them. This has 2 solutions. You can either put an Exit Sub in your test of the return value:
If Author.Length = 0 Then
MsgBox ("Not Found")
Range("A1").Value = "Not found"
Exit Sub
End If
Or you can initialize the arrays at the start of the function.
AuthorArray = Split(vbNullString)
BookTypeArray = Split(vbNullString)
This also has the added benefit of allowing you to skip all of the hoops in your array resizing to determine if they have been initialized. Split(vbNullString) will return an array with a UBound of -1 (MyVariantArray = Array() will do the same for arrays of Variant). That allows you to rewrite Sub AddValue like this:
Sub AddValue(arr, v)
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = v
End Sub
Finally, I'd take #SOofXWLS's suggestion and #barrowc's suggestions and use explicit object types since you are late binding. That way your IntelliSense will show auto-complete lists at very least. If you don't know what types of objects are returned, just hit F2 for the Object Browser and check:
If you don't know where to even start with a new object model, you can also use this quick and dirty trick...
Dim XMLFile As Object
Set XMLFile = CreateObject("Microsoft.XMLDOM")
Debug.Print TypeName(XMLFile) 'DOMDocument
... and then...
Dim XMLFile As DOMDocument
I have few "Why?"s about evaluate...
Sub TestEvaluate()
Dim Tag As String
Tag = "5"
Tag = Evaluate(Tag) 'works fine
Tag = "1"
Tag = Evaluate(Tag) 'error 438 wrong property or method(-> my 1st "Why?")
But ok i can handle it:
Tag = "1"
Tag = [Tag] 'works fine
Now I need to evaluate a property of some object:
Dim Object As cObject
Set Object = New cObject
Object.pProperty = "5"
Tag = Evaluate(Object.pProperty) 'Works fine
And again the same problem as above:
Object.pProperty = "1"
Tag = Evaluate(Object.pProperty) '438 wrong property or method
But now i'm traped, becouse:
Tag = [Object.pProperty] 'generates error 13 type mismatch(-> my 2nds "Why?")
Is there some solution without the need to use a new variable?
Dim TempTag As String
TempTag = Object.pProperty
Tag = [TempTag] 'everything fine again
End Sub
i found out, in my case VBA.Evaluate("1") generates an object according to
debug.print VBA.VarType(evauate("1"))
It`s just a bug? (win8.1 xl2007)
I put the expression into brackets and the problem disappeared; works fine now:
Tag = Evaluate("(" & Tag & ")")
This is better solution for me:
Tag = Evaluate(Tag & "+0")
It is a solution for the Error 2015 when the Tag="" as well.
I have a simple function that is going to pull from a specific Cell (N4). If there are cells below it then it will loop and collect all the content of the cell and separate with comma.
I'm getting #VALUE! error in excel right now and I kind of know where my issue lies but can not figure how to fix it, since I am not that proficient with excel-vba code. I think the issue is with ActiveSheet.Range("N4").Value and the offset part.
I am not sure how to offset then select the value in the text then add it to my string Value.
Any thought on how I can select the content of cell and add to string variable and doing the same when you offset?
Here is my code:
Function pullshit() As String
Dim output As String
Dim counter As Integer
counter = 1
output = ActiveSheet.Range("N4").Value
If Application.offset(N4, counter, 0).Value = "" Then
pullshit = output
Else
While counter <> 0
output = output + ", " + Application.offset(N4, counter, 0).Value
counter = counter + 1
If Application.offset(N4, counter, 0) = "" Then
counter = 0
End If
Wend
pullshit = output
End If
End Function
Offset use is wrong. Try this.
Function pullshit() As String
Dim output As String
Dim counter As Integer
counter = 1
output = ActiveSheet.Range("N4").Value
If Range("N4").Offset(counter, 0).Value = "" Then
pullshit = output
Else
While counter <> 0
output = output + ", " + Range("N4").Offset(counter, 0).Value
counter = counter + 1
If Range("N4").Offset(counter, 0) = "" Then
counter = 0
End If
Wend
pullshit = output
End If
End Function
Use of the function in a screenshot
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.