返回列表 上一主題 發帖

[發問] 如何找出網站原始檔網址

[版主管理留言]
  • GBKEE(2014/2/6 08:02): 32#的程式碼已更新

回復 32# GBKEE


先謝謝g大
目前發現一個問題例如當抓股票代號2886時候
會把網頁上的圖片 圖片.JPG 也一併抓下來
再抓第二次時候該圖片會殘留
有辦法抓第二次時刪除或是第一次只抓文字,表格嘛?
再次麻煩g大  謝謝

TOP

本帖最後由 GBKEE 於 2014-1-28 07:00 編輯

回復 31# pollllopkimo
  1. Option Explicit
  2. Sub 公開資訊網頁()
  3.     Dim A As Object, E As Object, Sh As Worksheet
  4.     Set Sh = Sheets("sheet1")  '物件: 指定工作表
  5.     Sh.Activate
  6.     With CreateObject("InternetExplorer.Application")
  7.         '.Visible = True
  8.         ' .Navigate "http://mops.twse.com.tw/mops/web/t164sb04"     '網址:綜合損益表
  9.         .Navigate "http://mops.twse.com.tw/mops/web/stapap1"        '網址:董監事持股餘額明細資
  10.         Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
  11.             .document.getElementById("isnew").Value = "false"       '選擇: 歷史資料
  12.             '註解上一行程式碼為 -> 選擇: 最新資料,不會執行 If 內程式碼
  13.            
  14.             If .document.getElementById("isnew").Value = "false" Then
  15.              .document.getElementById("isnew").FireEvent ("onchange")
  16.                 .document.getElementById("year").Value = Sh.Range("C1")       '年度
  17.                 '.document.getElementById("season").Value = "01"    '綜合損益表:第1季(季別)
  18.                 .document.getElementById("month").Value = Format(Sh.Range("D1"), "00")    '董監事持股餘額明細資料:月份
  19.             End If
  20.             '********************************************************************
  21.            For Each A In .document.getelementSbyTAGNAME("INPUT")
  22.            
  23.                 If A.Name = "co_id" Then A.Value = Sh.Range("b1")       '股票代號
  24.                
  25.                
  26.                 If A.Value = " 搜尋 " Then A.Click                     '按下 搜尋
  27.             Next
  28.             Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
  29.             For Each E In .document.ALL.TAGS("div")
  30.                 If E.ID = "table01" Then
  31.                     .document.body.innerHTML = E.outerHTML
  32.                     .ExecWB 17, 2       '  Select All
  33.                     .ExecWB 12, 2       '  Copy selection
  34.                     Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
  35.                     With Sh
  36.                         .UsedRange.Offset(4).Clear
  37.                         .Range("B5").Select
  38.                         .PasteSpecial Format:="HTML"
  39.                         .Range("B5").Select
  40.                         If .Shapes.Count > 0 Then  '有圖片
  41.                             .Shapes.SelectAll
  42.                             Selection.Delete
  43.                         End If
  44.                     End With
  45.                 End If
  46.             Next
  47.         .Quit                          '關閉 IE
  48.     End With
  49. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 30# GBKEE


請參考附件
麻煩G大了  謝謝

發問.rar (12.17 KB)

TOP

回復 29# pollllopkimo

上傳檔案看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# GBKEE


請教g大
若股票代號改在b1儲存格這沒有問題
年份要改成在c1儲存格~改出來都失敗
月份要改成在d1儲存格~改出來都失敗
以及最後的
下載產生資料結果要放在b2儲存格而不要放在a1儲存格  

還請多多幫忙 謝謝

TOP

厲害~感謝分享

TOP

厲害~感謝分享

TOP

我落伍了∼∼(拭淚)

TOP

了解了,感謝G大,幫忙及指教

TOP

本帖最後由 GBKEE 於 2014-1-5 07:10 編輯

回復 23# blue2263
你要多了解VBA的方法.屬性.函數

ActiveCell.Offset(0, 0).Range("A1").Select
分解:   .Offset(0, 0) :原位置
        .Offset(0, 0).Range("A1") :原位置的A1
           那不就一樣是 ActiveCell

10# 39行程式碼: 原位置下移一列位置
  1.   Set Rng(1) = Rng(1).Offset(1)
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 布施如播種,以歡喜心滋潤種子,才會發芽。
返回列表 上一主題