Board logo

標題: 網頁表格複製 ?? [打印本頁]

作者: GaryC    時間: 2015-8-27 23:17     標題: 網頁表格複製 ??

請問各位大大,原程式碼(如下),可指定日期下載表格,但珳日來,卻只能下載到最新日期的資料,
不知vba 那出錯了? 請指正∼ 謝謝 !

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xDate As String


   Worksheets("匯總").Select
   xDate = Worksheets("匯總").Range("B6")
   
        With Target
        If .Row = 6 And .Column = 2 Then
            If .Value <> 0 Then              ' 日期改變觸發下載
            Worksheets("加權指").Select
            
            
            With CreateObject("InternetExplorer.Application")
                .Visible = True
                .Navigate "http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/MI_INDEX.php"
            Do While .Busy Or .readyState <> 4: DoEvents: Loop

                    With .document
                        
                            .ALL("qdate").Value = Format(xDate, "E/MM/DD") '日期可修改
                            .ALL("selectType").Value = "MS"
                            .ALL("query-button").Click
                           
                     
                  
               
                       
                       
                     End With
                     
                       If InStr(.document.BODY.innerText, "查無資料") Then
                             If xDate = xDate Then   '測試用********
                                'If xDate  >= Date Then   '正式常程式碼
                                    Debug.Print xDate       '驗證用 可刪除
                                    xDate = xDate
                                   
                                End If
                                 '.Quit
                                MsgBox Format(xDate, "YYYY/M/D") & " 查無資料"
                                Exit Sub
                        End If
                     
                     
                Set A = .document.GetElementsByTagName("table")
                        
                     
                            .document.BODY.innerHTML = A(3).outerHTML '取最後的一個"table"
                           
                              
                     
                       .execwb 17, 1      '  Select All
                       .execwb 12, 2      '  Copy selection
                       .Quit              '關閉網頁
                        With Worksheets("加權指").Activate   '可指定工作表
                         Worksheets("加權指").UsedRange.Clear
                         Worksheets("加權指").Range("A1").Activate
                         ActiveSheet.PasteSpecial Format:=HTML, Link:=False, DisplayAsIcon:=False, NOHTMLFormatting:=True
                         Worksheets("加權指").Columns.AutoFit
                        End With
                        
                        
                    
            End With
            Else: .Offset(0, 1) = ""
            End If
        End If
        End With

End Sub





歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)