Thursday, December 16, 2010

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

17 comments:

  1. "Ayo segera bergabung bersama kami di GADISPOKER
    ▬▬▬▬▬▬▬▬▬▬▬▬ஜ۩۞۩ஜ▬▬▬▬▬▬▬▬▬▬▬▬
    Rasakan sensasinya bermain 7 permainan hanya mengunakan 1 akun/ID
    Hanya dengan modal Rp10.000 kamu sudah bisa bermain permainan populer yang tersedia di GADISPOKER
    ♦POKER
    ♦DOMINO
    ♦CAPSA
    ♦CEME
    ♦CEME KELILING
    ♦SUPER TEN
    ♦OMAHA
    Dapatkan berbagai bonus dari kami
    ♣♣ BONUS DEPOSIT SETIAP HARI
    ● Bonus Deposit 5rb-10rb ( S&K Berlaku )
    ♣♣ BONUS TURN OVER Up to 0.5% GADISPOKER
    ● Bonus diberikan setiap hari kamis
    ● Perhitungan bonus Up to 0,5% dari jumlah turn over selama 1 minggu (Kamis - Rabu)
    ● Bonus diberikan apabila mencapai Turn Over sebesar Rp 1,000,000 dalam 1 minggu
    ♣♣ BONUS REFFERAL 10% SEUMUR HIDUP GADISPOKER
    ● Bonus diberikan setiap hari kamis
    ● Bonus Akan di berikan jika Anda mengajak teman anda bermain di GADISPOKER
    ● Sewaktu melakukan Pendaftaran jangan Lupa masukkan ID anda di kolom refferal pendaftaran teman anda
    ● Semakin banyak teman anda bermain semakin banyak juga bonus yang akan anda terima.
    ♣♣ HADIAH JACKPOT PULUHAN JUTAAN RUPIAH BERSAMA GADISPOKER
    ♣♣ Turnamen Poker Hadiah Jutaan Rupiah

    Pelayanan yang kami sediakan di GADISPOKER :

    24 jam customer service yang siap melayani anda
    Transaksi Depo/WD super cepat
    100% player VS player (No Robot/BOT)
    Support Bank Lokal Indonesia (BCA, MANDIRI, BNI & BRI)

    Bagi teman-teman yang tertarik, kunjungi kami di :
    www.pokergadis .com (spasi dihilangkan)"

    dewa poker

    ReplyDelete