Generating XML from Excel VBA

[davulf]

Hi Experts,

I know that it is possible to generate XML using VBA in Excel. What I am trying to do, however, is to generate the following XML structure in an interval format. Every 5 seconds, I need to generate (update) the XML that is created, by adding a new <DAY> node, and all children.

<VEHICLE1>
	<DAY1>
		<x>95</x>
		<y>95</y>
		<speed>5</speed>
		<status>"On Time"</status>
	</DAY1>
	<DAY2>
		<x>91</x>
		<y>91</y>
		<speed>4</speed>
		<status>"On Time"</status>
	</DAY2>
</VEHICLE1>
<VEHICLE2>
	<DAY1>
		<x>3</x>
		<y>3</y>
		<speed>3</speed>
		<status>"Slight Delay"</status>
	</DAY1>
	<DAY2>
		<x>8</x>
		<y>8</y>
		<speed>5</speed>
		<status>"On Time"</status>
	</DAY2>
</VEHICLE2>

Is this possible?

Thanks,
DaVuLF

 

[Oorang]

Uhm yes it is possible Could you be more specific where you were hung up?

 

[davulf]

Just wondering how, is all. I've written out an algorithm.

For each i | i<6 | i++
	Create vehicle[i]
End For

//Target time for vehicles
days = 15
distance = 20



//Establish a counter to determine the number of KM that the vehicle has moved
vehicle[i].counter = 0

//Establish a counter to determine how many days the vehicle has been driving for
vehicle[i].days = 0

onInterval (10 seconds){
	if(vehicle[i].counter < 20){
		vehicle[i].counter = vehicle[i].counter + int(rand()*3+1)
		if((vehicle[i].counter / vehicle[i].days) < (distance / days)){
			vehicle[i].status = 1
		} else {
			vehicle[i].status = 0
		}
	}
}

For each i | i<6 | i++
	if(vehicle[i].counter > 20){
		vehicle[i].counter = 20
	}
End For

CreateXML(){
print("<XML>")

For i | i<=5 | i++
	print("<"+vehicle[i]+">")
		print("<position>"+vehicle[i].counter+"</position>")
		print("<status>"+vehicle[i].status+"</status>")
	print("</"+vehicle[i]+">")
End For

print("</XML>")

End Sub();

Does that make sense?

 

[Oorang]

Yes that makes perfect sense. Now that we have nailed down the output, what is the input? Spreadsheet?

 

[davulf]

There is essentially no input. If you look at the code, I'm not looking to the spreadsheet for anything. I just this VBA so that I can put a button inside of an Excel spreadsheet that I can click on to generate the XML that updates every 10 seconds.

I'm just not sure how to translate that algorithm into VBA code.

 

[Oorang]

lol Well there must be input of some type, be it a file or random generation of values etc. Buy you can output anything that wasn't created somehow.

At any rate, here is a simple timer:

Option Explicit
Public Enum eTimeInterval
    eYear
    eQuarter
    eMonth
    eDayOfYear
    eDay
    eWeekday
    eWeek
    eHour
    eMinute
    eSecond
End Enum
Public Sub Test()
    Debug.Print Now
    Timer eSecond, 1, "Test"
End Sub

Public Sub Timer(ByVal interval As eTimeInterval, ByVal increment As Double, ByVal procedure As String)
    Excel.Application.OnTime DateAdd(TimeIntervalToString(interval), increment, Now()), procedure
End Sub
Private Function TimeIntervalToString(ByVal interval As eTimeInterval) As String
    Dim strRtnVal As String
    Select Case interval
        Case eTimeInterval.eYear:       strRtnVal = "yyyy"
        Case eTimeInterval.eQuarter:    strRtnVal = "q"
        Case eTimeInterval.eMonth:      strRtnVal = "m"
        Case eTimeInterval.eDayOfYear:  strRtnVal = "y"
        Case eTimeInterval.eDay:        strRtnVal = "d"
        Case eTimeInterval.eWeekday:    strRtnVal = "w"
        Case eTimeInterval.eWeek:       strRtnVal = "ww"
        Case eTimeInterval.eHour:       strRtnVal = "h"
        Case eTimeInterval.eMinute:     strRtnVal = "n"
        Case eTimeInterval.eSecond:     strRtnVal = "s"
    End Select
    TimeIntervalToString = strRtnVal
End Function

And here is a simple way to write a string:

Sub Example2()
    Dim strSomeValue As String
    strSomeValue = "<w00t1!>I like cheese.</w00t1!>"
    WriteString "C:\Test\textB.xml", strSomeValue, True
End Sub
Public Sub WriteString(ByVal path As String, ByVal value As String, Optional overwrite As Boolean = False)
    Dim lngFileNum As Long
    If LenB(Dir(path)) Then
        If overwrite Then
            Kill path
        Else
            Err.Raise 70
        End If
    End If
    lngFileNum = FreeFile
    Open path For Binary Access Write Lock Read Write As lngFileNum
    Put lngFileNum, , value
    Close lngFileNum
End Sub

 

[davulf]

Excellent. Thanks Oorang, that is exactly what I was looking for. I'll post back if I have any specific problems.

Again, great work!