ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð°Ý¤@¤U CreateObject ªº¥Îªk

[µo°Ý] ½Ð°Ý¤@¤U CreateObject ªº¥Îªk

Sub download_TaiStock()
'
Dim myURL As String
Dim stock_code As String ' stock code
Dim ini_year As String ' initial yaer
Dim integer_ini_month As Integer ' initial month, integer
Dim ini_month As String ' initial month, string
Dim ini_day As String ' initial day
Dim end_year As String ' end year
Dim integer_end_month As Integer ' end month, integer
Dim end_month As String 'end month, string
Dim end_day As String 'end day
Dim file_dir As String ' CSV direction
'
Dim num_TW As Integer ' number of TW stocks
Dim num_TWO As Integer ' number of TWO stocks
'
Dim WinHttpReq As Object 'define object
'
'initialization, define initial date & end date, and file directory
'
ini_year = Sheets("sheet1").Range("B2")
integer_ini_month = Sheets("sheet1").Range("B3") - 1
ini_day = Sheets("sheet1").Range("B4")
end_year = Sheets("sheet1").Range("D2")
integer_end_month = Sheets("sheet1").Range("D3") - 1
end_day = Sheets("sheet1").Range("D4")
'
'modify the data type of "month"
'
If integer_ini_month < 10 Then
   ini_month = "0" & Format(integer_ini_month) ' change type
   Else
   ini_month = Format(integer_ini_month) ' change type
End If
'
If integer_end_month < 10 Then
   end_month = "0" & Format(integer_end_month) ' change type
   Else
   end_month = Format(integer_end_month) 'change type
End If
'
'calculate number of stocks, TW stock & TWO stock
'
num_TW = count_column("sheet1", "F1") - 1
num_TWO = count_column("sheet1", "G1") - 1
'
Sheets("sheet1").Range("D8") = num_TW  'output number of TW stocks
Sheets("sheet1").Range("D9") = num_TWO ' output of number of TWO stocks
'
'download TW stock
'
If num_TW > 0 Then
  For i = 1 To num_TW
    stock_code = Sheets("sheet1").Cells(i + 1, 6) ' catch TW stock code
    file_dir = Sheets("sheet1").Range("B6") & stock_code & ".csv" 'file name is stock code
    '
    myURL = "http://ichart.finance.yahoo.com/table.csv?s=" & stock_code & ".TW&a=" & ini_month & "&b=" & ini_day & "&c=" & ini_year & _
        "&d=" & end_month & "&e=" & end_day & "&f=" & end_year & "&g=d&ignore=.csv" ' define website
        'Dim WinHttpReq As Object
        Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", myURL, False
        WinHttpReq.Send
        '
        myURL = WinHttpReq.ResponseBody
        If WinHttpReq.Status = 200 Then
           Set oStream = CreateObject("ADODB.Stream")
           oStream.Open
           oStream.Type = 1
           oStream.Write WinHttpReq.ResponseBody
           oStream.SaveToFile (file_dir)
           oStream.Close
        End If

  Next
End If
'
'download TWO stock
'
If num_TWO > 0 Then
  For i = 1 To num_TWO
    stock_code = Sheets("sheet1").Cells(i + 1, 7) ' catch TWO stock code
    file_dir = Sheets("sheet1").Range("B6") & stock_code & ".csv" 'file name is stock code
    '
    myURL = "http://ichart.finance.yahoo.com/table.csv?s=" & stock_code & ".TWO&a=" & ini_month & "&b=" & ini_day & "&c=" & ini_year & _
        "&d=" & end_month & "&e=" & end_day & "&f=" & end_year & "&g=d&ignore=.csv" ' define website
        'Dim WinHttpReq As Object
        Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", myURL, False
        WinHttpReq.Send
        '
        myURL = WinHttpReq.ResponseBody
        If WinHttpReq.Status = 200 Then
           Set oStream = CreateObject("ADODB.Stream")
           oStream.Open
           oStream.Type = 1
           oStream.Write WinHttpReq.ResponseBody
           oStream.SaveToFile (file_dir)
           oStream.Close
        End If
  Next
End If
'
End Sub
Function count_column(name As String, str As String) As Integer
' name is the sheet name
' str is the cell number
'
Sheets(name).Range(str).Select
'
count_column = 0
'
Do
  If ActiveCell.Offset(count_column, 0).Value = "" Then
  Exit Do
  End If
  count_column = count_column + 1
Loop
'
End Function


¨ä¥Lªº³¡¥÷§Ú³£§Ë±oÀ´¡A¦ý´N¬O¨ì crativeobject ¨ºùاڥd¤F«Ü¤[¡A¤WºôGoogle¤]§ä¤£¨ì§Ú­nªºµª®×¡A§Ú¬O­ÓVBA·s¤â¡A¥i¥H½Ð¦U¦ì¤j¤jÀ°§Ú¸Ñ´b¤@¤U¶Ü?? ÁÙ¬O¦³¬Æ»ò¤å³¹¥i¥H¬ÝÀ´¥¦ªº?

´N¬O³o¤@¬q¬Ý¤£À´
        Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", myURL, False
        WinHttpReq.Send
        '
        myURL = WinHttpReq.ResponseBody
        If WinHttpReq.Status = 200 Then
           Set oStream = CreateObject("ADODB.Stream")
           oStream.Open
           oStream.Type = 1
           oStream.Write WinHttpReq.ResponseBody
           oStream.SaveToFile (file_dir)
           oStream.Close
        End If

³Â·Ð«ü±Ð

Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", myURL, False  '¹w³Æ¥ÎXMLHTTP library  ³s±µurl (¥Îget¤è¦¡,¨ä¥Lªº¦³POST)
        WinHttpReq.Send '³s±µurl
        '
        myURL = WinHttpReq.ResponseBody '®³¥X¦^¶Ç¸ê®Æ(µ¹¤U¤@¬dSTATUS¥Î)
        If WinHttpReq.Status = 200 Then ; '¦pªGÂI¶Ç¬O"¦³¸ê®Æ" 200, ¦æ¤U¤@¨B. ±`¨£ªº§ä¤£¨ì¦³404 (FILE NOT FOUND)
           Set oStream = CreateObject("ADODB.Stream")
           oStream.Open
           oStream.Type = 1
           oStream.Write WinHttpReq.ResponseBody
           oStream.SaveToFile (file_dir)'§â¦^¶Çªº¸ê®Æ¸gADODB.STREAM ±µ»é¨ìÀɮצì¸m
           oStream.Close
        End If
À´±oµo°Ý,µª®×´N·|¦b¨ä¤¤

¤µ¤éの¤@¬íは  ©ú¤éにない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

        ÀR«ä¦Û¦b : ¯àµ½¥Î®É¶¡ªº¤H¡A¥²¯à´x´¤¦Û¤v§V¤Oªº¤è¦V¡C
ªð¦^¦Cªí ¤W¤@¥DÃD