- 帖子
- 1
- 主題
- 2
- 精華
- 0
- 積分
- 2
- 點名
- 0
- 作業系統
- win 7
- 軟體版本
- Office 2010
- 閱讀權限
- 10
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2014-6-3
- 最後登錄
- 2022-8-11
 
|
過去用下列程式可以下載証交所每日交易資料。但最近無法下載，請指正。謝謝！
Sub saveCSVfmURL(selDate As String)
Dim st, nt, mond, dayd
Dim myURL, myURL2 As String
Dim oStream As Object 'ADODB.Stream
Dim WinHttpReq As Object 'XMLHTTP
Dim fileIdx As String
Dim folderLoc As String
Dim twPath As String
Dim twoPath As String
Dim cTw As String
Dim cTwo As String
Dim y1 As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fileIdx = selDate
folderLoc = Sheets("Download").Range("F2").Value
st = VBA.Left(fileIdx, 4) - 1911
nt = VBA.Right(fileIdx, 4)
dayd = VBA.Right(nt, 2)
mond = VBA.Left(nt, 2)
twPath = folderLoc & "\TW\"
If Len(Dir(twPath, vbDirectory)) = 0 Then
MkDir twPath
End If
cTw = twPath & selDate & "_TW.csv"
myURL = "http://www.twse.com.tw/exchangeReport/MI_INDEX?response=csv&date=" & VBA.Left(fileIdx, 4) & mond & dayd & "&type=ALLBUT0999"
Debug.Print myURL
Set WinHttpReq = CreateObject("MSXML2.XMLHTTP")
With WinHttpReq
'.Open "GET", myURL, False
.send
myURL = .responseText
End With
If myURL <> "" Then
Set oStream = CreateObject("ADODB.Stream")
With oStream
.Open
.Type = 1
.Write WinHttpReq.responseBody
fileIdx = twPath & selDate & "_TW.csv"
On Error Resume Next
Kill fileIdx
On Error GoTo 0
.SaveToFile fileIdx
.Close
End With
End If
Set WinHttpReq = Nothing
Set oStream = Nothing
Dim removeSmallFile As Integer
removeSmallFile = ActiveSheet.Shapes("cBox_sFile").ControlFormat.Value
If removeSmallFile = 1 Then
Call fileSizeCheck(twPath)
Call fileSizeCheck(twoPath)
End If
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub fileSizeCheck(mySourcePath)
Dim OFS As Object
Dim mySource As Object
Dim myFile As Object
Set OFS = CreateObject("Scripting.FileSystemObject")
Set mySource = OFS.getFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
If myFile.Size < 10000 Then
Kill myFile
End If
Next
End Sub |
|
發表於 2019-6-27 12:22
| 
