- ©«¤l
 - 3 
 - ¥DÃD
 - 1 
 - ºëµØ
 - 0 
 - ¿n¤À
 - 8 
 - ÂI¦W
 - 0  
 - §@·~¨t²Î
 - win 7 
 - ³nÅ骩¥»
 - SP1 
 - ¾\ŪÅv
 - 10 
 - µù¥U®É¶¡
 - 2013-5-21 
 - ³Ì«áµn¿ý
 - 2015-11-14 
 
  | 
[µ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 
 
³Â·Ð«ü±Ð |   
 
 
 
 |