(不定期更新)使用VBA解決 excel web 查詢無法匯入、匯入太慢的股市資料

snare wrote:
因為您是私人網站，我...(恕刪)

smart3135 wrote:
都還是會出錯，一樣的寫法，用在公司其他網頁卻可以，不知道是不是這個網頁本身的問題

Sub test()
    
    Dim chrome As New Selenium.ChromeDriver, UrL As String, keys As New keys
    
    UrL = "https://www.google.com.tw/"
        
    With chrome
        .Get UrL
        
        .SendKeys ("clear test")
        
        .Wait 2000
        .SendKeys keys.Tab
        
        .Wait 2000
        .SendKeys keys.Enter
        
        .Wait 3000
        .SendKeys ("mobile01")
        
        .Wait 2000
        .SendKeys keys.Tab
        
        .Wait 2000
        .SendKeys keys.Tab
        
        .Wait 2000
        .SendKeys keys.Tab
        
        .Wait 2000
        .SendKeys keys.Enter
        
        
    End With
    
     
    Stop
    
    chrome.Quit
    Set chrome = Nothing
    
End Sub

Dylan67 wrote:
有沒有什麼辦法可以得到這個數組的下標：17，以及依序循環取得這個數組的索引：c、ch、d、ex、h...

snare wrote:
那個錯誤訊息，跟記憶(恕刪)

smart3135 wrote:
看一下錯誤訊息和什麼有關

機八陽 wrote:
請問為什麼上市下載正...(恕刪)

機八陽 wrote:
之前上個月還正常下載都可使用，但這個月就不行(上櫃下載不下來)

#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If



Sub Get_Tpex_Twse_Csv()

    Dim UrL As String, Target As String, TpexCsv As String, Clipboard As Object, Tpex As Object
    Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set Tpex = CreateObject("scripting.filesystemobject")
    
    On Error GoTo checkid
    

    Target = "c:\excel\" '暫存目錄，windows 10可能有權限問題，需在選項內設定信任位置，或改目錄位置
    If Dir(Target, vbDirectory) = "" Then MkDir Target
    '注意，暫存目錄下的檔案，會在無任何提示下刪除
    If Dir(Target & "*.*") <> "" Then Kill Target & "*.*"
      
    Sheets("工作表1").Cells.Clear
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'UrL = "https://www.tpex.org.tw/web/stock/aftertrading/daily_close_quotes/stk_quote_result.php?l=zh-tw&o=csv&d=111/08/12&s=0,asc,0"
    UrL = "https://www.twse.com.tw/exchangeReport/MI_INDEX?response=csv&date=20220812&type=ALLBUT0999"
    
    URLDownloadToFile 0, UrL, Target & "temp.csv", 0, 0

    '如果單純只是下載檔案，那程式碼到這裡就可以結束了

    With Tpex.OpenTextFile(Target & "temp.csv", 1)
         TpexCsv = Replace(Replace(.ReadAll, "=", ""), "元,", "元.")
         .Close
    End With
     
    Clipboard.SetText TpexCsv
    Clipboard.PutInClipboard
            
    With Sheets("工作表1")
        .Cells(1, 1).Select
        .Columns(1).NumberFormat = "@"
        .PasteSpecial NoHTMLFormatting:=True
        .Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True, FieldInfo:=Array(Array(1, 2), Array(2, 1)), TrailingMinusNumbers:=True
        .Columns.AutoFit
        .Columns(1).ColumnWidth = 40
        .Cells(1, 1).Select
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Set Clipboard = Nothing
    Set Tpex = Nothing

checkid:

    If Err.Number <> 0 Then
         Debug.Print Err.Description
    End If

End Sub