Automatically Import XML data into excel at a fixed time interval

'Function: Automatically Import online XML data into  excel at a fixed time interval'
'Language: VBA'
'Author: Vivian N. Yang'
'Date: Dec. 12, 2010'

'Define Global Variables'
'Inputs'
Dim TotalCount As Integer 'Total Number of Data Collections (#)'
Dim TimeInterval As String 'Time Interval to collect data (text format, e.g."00:01:00" means 1 minute)'
Dim Links() As String 'Web Links to collect data'
Dim NumofLinks As Integer 'Number of Links (dimension of the array Links())'
Dim Outputs() As String 'Names of the worksheets to store the outputs'
'Others'
Dim CurrentCount As Integer
Dim SelRange As Range
Dim Actsheet As Worksheet

Sub Main()
' Clear Outputs'
Call Clear_Output
' Get Inputs'
Call Get_Inputs

' Start the data collection'
CurrentCount = 1
Dim XmlMap As XmlMap
For Each XmlMap In ActiveWorkbook.XmlMaps
XmlMap.Delete
Next
' Write Outputs'
Dim i As Integer
For i = 1 To NumofLinks
Sheets(Outputs(i)).Cells(1, 1).NumberFormat = "h:mm:ss AM/PM"
Sheets(Outputs(i)).Cells(1, 1).Value = Format(Now(), "hh:mm:ss")
ActiveWorkbook.XmlImport URL:=Links(i), ImportMap:=Nothing, Overwrite:=True, Destination:=Sheets(Outputs(i)).Cells(2, 1)
Next i

'Start the OnTimeMacro'
Call OnTimeMacro

End Sub

Sub Get_Inputs()
Dim Row As Integer
Dim Col As Integer
Dim i As Integer
Row = 2
Col = 2
NumofLinks = Sheets("Input").Cells(Row, Col).Value
ReDim Links(1 To NumofLinks)
ReDim Outputs(1 To NumofLinks)

For i = 1 To NumofLinks
Row = Row + 1
Links(i) = Sheets("Input").Cells(Row, Col).Value
Outputs(i) = Sheets("Input").Cells(Row, Col + 1).Value
Sheets(Outputs(i)).Cells(1, 1).Value = i
Debug.Print Outputs(i)
Next i
Row = 8
TimeInterval = Sheets("Input").Cells(Row, Col).Value
Row = 9
TotalCount = Sheets("Input").Cells(Row, Col).Value
End Sub


'The time interval can be changed in this subroutine OnTimeMacro()'
'Example: 5 seconds -TimeValue("00:00:05")'
'Example: 1 minute -TimeValue("00:01:00")'

Sub OnTimeMacro()
' Run the RunEvery1Min macro TotalCount times.'
If CurrentCount < TotalCount Then
' Run the RunEvery1Min macro in 1 minute'
'Application.OnTime Now + TimeValue("00:00:10"), "RunEveryTimeInterval"'
Application.OnTime Now + TimeValue(TimeInterval), "RunEveryTimeInterval"
' Increment icount by 1.'
CurrentCount = CurrentCount + 1
Else
' CurrentCount is greater than TotalCount, so exit the macro.'
Exit Sub
End If
End Sub

Sub RunEveryTimeInterval()
Dim Row As Integer
Row = CurrentCount * 7
' Write Outputs'
'Delete all existing XmlMaps'
Dim XmlMap As XmlMap
For Each XmlMap In ActiveWorkbook.XmlMaps
XmlMap.Delete
Next
'Import data'
Dim i As Integer
For i = 1 To NumofLinks
Sheets(Outputs(i)).Cells(Row, 1).NumberFormat = "h:mm:ss AM/PM"
Sheets(Outputs(i)).Cells(Row, 1).Value = Format(Now(), "hh:mm:ss")
ActiveWorkbook.XmlImport URL:=Links(i), ImportMap:=Nothing, Overwrite:=True, Destination:=Sheets(Outputs(i)).Cells(Row + 1, 1)
Next i
' Runs the OnTimeMacro again.'
Call OnTimeMacro

End Sub