麻辣家族討論版版 - Powered by Discuz! Board

標題: 有關EXCEL VBA 抓取不到完整網址CSV問題 [打印本頁]

作者: vesperlee 時間: 2013-11-8 21:36 標題: 請教如何運用 VBA 把網路*.csv 的檔案下載到EXCEL的表格裏？

請教如何運用 VBA 把
特定日期的鉅額交易日成交資訊 - 資料
下載到EXCEL的表格裏？
參考網址：
http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php

[attach]16648[/attach]

[attach]16649[/attach]

作者: GBKEE 時間: 2013-11-9 09:19

本帖最後由 GBKEE 於 2013-11-9 17:13 編輯

回復 1# vesperlee
URL; http://www.twse.com.tw/ 多出一空格不適用2003後的新版本,
謝謝stillfish00幫忙除錯,已更正為 URL;http://www.twse.com.tw/

Option Explicit
Sub TEXT_102()
Dim YMD_day As String, N As Name, webURL As String
YMD_day = InputBox("輸入民國年度日期 : 102/10/07", "下載特定日期的資料", Format(Date - 1, "E/MM/DD"))
With Sheets("下載資料")
For Each N In .Names
N.Delete
Next
.Cells.Clear
'GetData_URL = "http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?edition=ch&filename=genpage/A" & YMD_day & ".dat&type=csv"
webURL = "URL;http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
With .QueryTables.Add(Connection:=webURL, Destination:=.Range("A1"))
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "data_table"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
End With
End Sub

複製代碼

作者: c_c_lai 時間: 2013-11-9 10:51

回復 2# GBKEE
[attach]16652[/attach]
執行到 .Refresh BackgroundQuery:=False 便出現 1004 的錯誤訊息。
請教您，這會是甚麼狀況？

作者: GBKEE 時間: 2013-11-9 11:00

本帖最後由 GBKEE 於 2013-11-9 11:10 編輯

回復 3# c_c_lai
少了一點 .Range("A1"),謝謝你的測試.(2#的程式碼已加上一點了)
因為作用中的工作表不是Sheets("下載資料")時,少了一點就是作用中的工作表的Range("A1")

With .QueryTables.Add(Connection:=webURL, Destination:=.Range("A1"))

複製代碼

作者: c_c_lai 時間: 2013-11-9 11:24

本帖最後由 c_c_lai 於 2013-11-9 11:31 編輯

回復 c_c_lai
少了一點 .Range("A1"),謝謝你的測試.(2#的程式碼已加上一點了)
因為作用中的工作表不是S ...
GBKEE 發表於 2013-11-9 11:00

之前我亦加上了一 "."，還是一樣的結果。
Destination:=.Range("A1")
我也是在找原因。在 2003 能執行嗎？

作者: GBKEE 時間: 2013-11-9 11:35

回復 5# c_c_lai
上傳檔案看看

作者: c_c_lai 時間: 2013-11-9 11:57

回復 6# GBKEE
[attach]16653[/attach]
目前無論是上傳附件或圖片，都必須另外使用 IE，
無法在 FireFox 內執行，非常地不方便，我也跟
小誌版主提過，還是無法上船，蠻困擾的。

作者: lutin111 時間: 2013-11-9 12:08

Sub TEXT_102()
Dim YMD_day As String, N As Name, webURL As String
YMD_day = InputBox("輸入民國年度日期 : 102/10/07", "下載特定日期的資料", Format(Date - 1, "E/MM/DD"))
With Sheets("下載資料")
   For Each N In .Names
         'N.Delete
   Next
      .Cells.Clear
   GetData_URL = "URL;http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?edition=ch&filename=genpage/A" & YMD_day & ".dat&type=csv"
      'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
      With .QueryTables.Add(Connection:=GetData_URL, Destination:=.Range("A1"))
         .WebSelectionType = xlSpecifiedTables
         .WebFormatting = xlWebFormattingNone
         .WebTables = "data_table"
         .WebPreFormattedTextToColumns = True
         .WebConsecutiveDelimitersAsOne = False
         .WebSingleBlockTextImport = False
         .WebDisableDateRecognition = False
         .WebDisableRedirections = True
         .Refresh BackgroundQuery:=False
      End With
End With
End Sub

作者: GBKEE 時間: 2013-11-9 12:10

回復 7# c_c_lai
你的檔案2003沒問題的,須請2007,2010來試試看
(目前無論是上傳附件或圖片，都必須另外使用 IE，會是這原因...)

作者: c_c_lai 時間: 2013-11-9 12:23

回復 9# GBKEE
應用 #8 的 GetData_URL 便 OK 了。

GetData_URL = "URL;http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?edition= _
ch&filename=genpage/A" & YMD_day & ".dat&type=csv"
' webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date= _
" & YMD_day & "&login_btn=查詢.dat"

複製代碼

內容是有些微不同，就是不甚了解它的實質套用、及如何應用。

作者: c_c_lai 時間: 2013-11-9 12:27

回復 8# lutin111
謝謝指教！
在網頁應用方面我純為新手，謝謝！

作者: GBKEE 時間: 2013-11-9 12:33

回復 10# c_c_lai
但傳回的永遠是102/11/08最近一天股市的資料

作者: c_c_lai 時間: 2013-11-9 12:40

回復 12# GBKEE
還真的呢，實在沒輒了！
這真的要感謝微軟的偉大貢獻 (版本差異性)。

作者: GBKEE 時間: 2013-11-9 13:56

回復 13# c_c_lai
可能是 "查詢" 的問題
請問java 的網頁可以抓的下來嗎？

webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=%ACd%B8%DF.dat"

複製代碼

作者: ML089 時間: 2013-11-9 15:32

回復 7# c_c_lai

我用 GOOGLE的CHROME一切OK

作者: ui123 時間: 2013-11-9 15:55

Thanks for share^^

作者: ML089 時間: 2013-11-9 16:01

回復 14# GBKEE

[attach]16654[/attach]

無法執行

作者: stillfish00 時間: 2013-11-9 16:51

本帖最後由 stillfish00 於 2013-11-9 16:54 編輯

回復 2# GBKEE
直接複製代碼時，"URL;"
後面會多了一個空格，刪掉空格就OK ( EXCEL2010 )。

作者: c_c_lai 時間: 2013-11-9 16:58

回復 14# GBKEE
回復 17# ML089
結論是 #17 樓的畫面。

作者: GBKEE 時間: 2013-11-9 17:02

本帖最後由 GBKEE 於 2013-11-9 17:05 編輯

回復 18# stillfish00
謝謝幫忙除錯.
回復 19# c_c_lai
stillfish00 已幫忙除錯

作者: c_c_lai 時間: 2013-11-9 17:06

回復 14# GBKEE
回復 18# stillfish00

webURL = "URL;http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
' webURL = "URL;http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=%ACd%B8%DF.dat"

複製代碼

兩者分別去除掉 Space 測試後，天空突然都變成晴天了！
在此亦一併向 stillfish00 大大言謝了。

作者: joey0415 時間: 2013-11-11 19:19

回復 21# c_c_lai

http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=102%2F11%2F11&combination_choice=simplex&login_btn=%ACd%B8%DF

用上面的網址就能querytable哦！

作者: GBKEE 時間: 2013-11-11 21:04

回復 22# joey0415
又多一個網址可web匯入,大夥熱烈的交流.
但樓主vesperlee,卻一點反應都沒有.(我們是剃頭擔子一頭熱的)

作者: c_c_lai 時間: 2013-11-11 22:18

回復 23# GBKEE
回復 22# joey0415
說的也是，主角都不見了！

作者: wufonna 時間: 2013-11-11 23:03

回復 22# joey0415

請問大大
上面的網址是如何得知的，努力學習中

作者: 特大雕 時間: 2013-11-13 21:45

初來學習、活到老、學到老。

作者: ML089 時間: 2013-11-13 22:14

回復 23# GBKEE

沒有關係啦，觀看學習的人很多，代表大家在此跟各位說聲，3Q

作者: ML089 時間: 2013-11-13 22:15

回復 24# c_c_lai

請問一次要回覆2人要怎樣處理

作者: c_c_lai 時間: 2013-11-14 06:00

本帖最後由 c_c_lai 於 2013-11-14 06:02 編輯

回復 28# ML089
道理非常簡單：
1.  先點選第一位要"回復"的當事人，進入回復畫面後複製 (Copy) 第一行的 "<b> ~ </b> "
   然後點選網頁左上角的 "<--"，悄然退出。不管事要回復幾位都如法泡製。
   (千萬不要點 "參與/回復主題"，否則對方會收到一個空訊息)
2.  直到最後一位要回復者，一樣點選"回復"，進入後再將剛才複製的內容一一
   貼入到第二行下方  (如有多位者，你可先將內容預先貼入到 "記事本"內)。
3.  我發覺你好像對 Excel 的"公式"應用，有非常深入地研究，應好好向你學習。

作者: ML089 時間: 2013-11-14 09:33

回復 29# c_c_lai

了解，謝謝

公式技巧也是在網站東抄西學觀摩而來，
如果要進階進級還是要參加進賽題磨練較能學習一些高技巧性方式，
我知道ExcelHome有競賽區可以參加磨練。

正在學習VBA有空希望你多多指教

作者: jak 時間: 2013-11-15 17:00

回復 22# joey0415

想請教大大
下列網址
http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?combination_choice=sub&cno=1&input_date=102/11/06
可不可以也用querytable呢？

作者: GBKEE 時間: 2013-11-17 09:42

回復 31# jak

Option Explicit
Sub ExA()
With ActiveSheet
With .QueryTables.Add("URL;http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?combination_choice=sub&cno=1&input_date=102/11/06", .[A1])
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """data_table"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End With
End Sub
Sub ExB()
With ActiveSheet
With .QueryTables(1)
' .WebSelectionType = xlSpecifiedTables
' .WebFormatting = xlWebFormattingNone
' .WebTables = """data_table"""
' .WebPreFormattedTextToColumns = True
' .WebConsecutiveDelimitersAsOne = True
' .WebSingleBlockTextImport = False
' .WebDisableDateRecognition = False
' .WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End With
End Sub

複製代碼

作者: joey0415 時間: 2013-11-17 12:56

回復 32# GBKEE

請問超版：

   Sub ExB()
      With ActiveSheet
         With .QueryTables(1)
            .Refresh BackgroundQuery:=False
         End With
      End With
End Sub

紅字處為什麼還要寫第二個SUB呢？
.QueryTables(1)

這又是什麼呢？是表示有一個QueryTables嗎？
為何又要再一次 .Refresh BackgroundQuery:=False[

謝謝超版

作者: GBKEE 時間: 2013-11-17 15:10

回復 33# joey0415
Sub ExA() 是新增一個QueryTable
Sub ExB() 是延續這QueryTable中查詢,不必一直用.QueryTables.Add,會佔用資源

作者: gto1208 時間: 2014-2-26 17:22

gbkee,c_c_lai您好：

我也有上述的問題，也是證交所網站問題，但試了很久都沒有結果，可以請教高手是哪裡出錯了嗎? 謝謝您
http://www.twse.com.tw/ch/trading/exchange/TWT93U/TWT93U.php#

Sub TEST123()
Dim YMD_day As String, N As Name, webURL As String
YMD_day = InputBox("輸入民國年度日期 : 102/10/07", "下載特定日期的資料", Format(Date - 1, "E/MM/DD"))
With Sheets("下載資料")
For Each N In .Names
'N.Delete
Next
.Cells.Clear
GetData_URL = "URL;http://www.twse.com.tw/ch/trading/exchange/TWT93U/TWT93U.php?edition=ch&filename=genpage/A" & YMD_day & ".dat&type=csv"
'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
With .QueryTables.Add(Connection:=GetData_URL, Destination:=.Range("A1"))
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "data_table"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
End With
End Sub

複製代碼

作者: gto1208 時間: 2014-2-26 20:23 標題: 有關EXCEL VBA 抓取不到完整網址CSV問題

各位高手您好，

因要抓先前已爬文，http://forum.twbts.com/viewthread.php?tid=10770，修改過後，資仍帶不出來，請想問各位高手是否php後面的語法使用有誤，謝謝大家^^

http://www.twse.com.tw/ch/trading/exchange/TWT93U/TWT93U.php

Option Explicit
Sub ExA()
With ActiveSheet
With .QueryTables.Add("URL;http://www.twse.com.tw/ch/trading/exchange/TWT93U/TWT93U.php#?combination_choice=sub&cno=1&input_date=103/02/25", .[A1])
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """data_table"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End With
End Sub

複製代碼

Sub TEST123()
Dim YMD_day As String, N As Name, webURL As String
YMD_day = InputBox("輸入民國年度日期 : 102/10/07", "下載特定日期的資料", Format(Date - 1, "E/MM/DD"))
With Sheets("下載資料")
For Each N In .Names
'N.Delete
Next
.Cells.Clear
GetData_URL = "URL;http://www.twse.com.tw/ch/trading/exchange/TWT93U/TWT93U.php?edition=ch&filename=genpage/A" & YMD_day & ".dat&type=csv"
'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
With .QueryTables.Add(Connection:=GetData_URL, Destination:=.Range("A1"))
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "data_table"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
End With
End Sub

複製代碼

作者: heavenweaver 時間: 2014-2-26 23:37

請試用一下吧

Sub TWT93U()
'
'
' 信用額度總量管制餘額表  @ TWSE 臺灣證券交易所 ﹥交易資訊 ﹥融資融券與可借券賣出額度 ﹥融券借券賣出餘額
' http://www.twse.com.tw/ch/trading/exchange/TWT93U/TWT93U.php
Dim YMD_day As String, N As Name, webURL As String
YMD_day = Format(Date, "E/MM/DD")
With Sheets("Sheet1")
      For Each N In .Names
         N.Delete
      Next
      .Cells.Clear
      webURL = "URL;http://www.twse.com.tw/ch/trading/exchange/TWT93U/TWT93U.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
      With .QueryTables.Add(Connection:=webURL, Destination:=.Range("A1"))
         .WebSelectionType = xlSpecifiedTables
         .WebFormatting = xlWebFormattingNone
         .WebTables = "7,9"
         .WebPreFormattedTextToColumns = True
         .WebConsecutiveDelimitersAsOne = False
         .WebSingleBlockTextImport = False
         .WebDisableDateRecognition = False
         .WebDisableRedirections = True
         .Refresh BackgroundQuery:=False
      End With
End With
End Sub

作者: heavenweaver 時間: 2014-2-27 00:54

回復 35# gto1208
改好了，請試用吧！

Sub TEST123()
      Dim YMD_day As String, N As Name, webURL As String
      YMD_day = InputBox("輸入民國年度日期 : 102/10/07", "下載特定日期的資料", Format(Date - 1, "E/MM/DD"))
      With Sheets("下載資料")
         For Each N In .Names
            'N.Delete
         Next
         .Cells.Clear
         GetData_URL = "URL;http://www.twse.com.tw/ch/trading/exchange/TWT93U/TWT93U.php?edition=ch&filename=genpage/A" & YMD_day & ".dat&type=csv"
         'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
         With .QueryTables.Add(Connection:=GetData_URL, Destination:=.Range("A1"))
               .WebSelectionType = xlSpecifiedTables
               .WebFormatting = xlWebFormattingNone
               .WebTables = "9"
               .WebPreFormattedTextToColumns = True
               .WebConsecutiveDelimitersAsOne = False
               .WebSingleBlockTextImport = False
               .WebDisableDateRecognition = False
               .WebDisableRedirections = True
               .Refresh BackgroundQuery:=False
         End With
         End With
      End With
End Sub

作者: gto1208 時間: 2014-2-27 10:57

謝謝高手太感謝了

作者: gto1208 時間: 2014-2-27 11:11

heavenweaver 您好

我目前有二個網址
http://www.gretai.org.tw/ch/stock/statistics/monthly/st42.php
http://www.gretai.org.tw/ch/stock/statistics/monthly/st44.php

都是屬於上述的狀況，我想請教一下，是否有工具可以查詢?edition=ch&filename=genpage/A" & YMD_day & ".dat&type=csv" --的參數資料出來呢，謝謝

作者: heavenweaver 時間: 2014-2-28 15:50

heavenweaver 您好
我目前有二個網址
http://www.gretai.org.tw/ch/stock/statistics/monthly/st42.php
都是屬於上述的狀況，我想請教一下，是否有工具可以查詢?edition=ch&filename=genpage/A" & YMD_day & ".dat&type=csv" --的參數資料出來呢，謝謝gto1208 發表於 2014-2-27 11:11

最直接的就是用瀏覽器本身所提供的網頁開發者工具如Chrome的檢查元素或FireFox的檢測元素
http://www.gretai.org.tw/ch/stock/statistics/monthly/st42.php
[attach]17622[/attach]
Request URL:http://www.gretai.org.tw/ch/stock/statistics/monthly/result_st42.php?timestamp=1393573668432
Form Data
ajax=true&input_stock_code=3260
兩者合併
http://www.gretai.org.tw/ch/stock/statistics/monthly/result_st42.php?ajax=true&input_stock_code=3260

http://www.gretai.org.tw/ch/stock/statistics/monthly/st44.php
[attach]17623[/attach]
http://www.gretai.org.tw/ch/stock/statistics/monthly/result_st44.php?ajax=true&yy=2014&input_stock_code=3260

作者: gto1208 時間: 2014-3-3 14:47

謝謝heavenweaver，又學到一招了

作者: jak 時間: 2014-3-6 11:38

回復 jak
GBKEE 發表於 2013-11-17 09:42

若是我想copy下列網址某天、某幾家的資料，http://stocker.com.tw/
可否請大大撥冗幫忙，有附檔

作者: GBKEE 時間: 2014-5-15 16:11

若是我想copy下列網址某天、某幾家的資料，http://stocker.com.tw/
可否請大大撥冗幫忙，有附檔
jak 發表於 2014/3/6 11:38

抱歉,沒有注意到,久等了.
試試看

<input type="text" name="StoNum" id="StoNum" style="width:100px" value="1101" onkeyup="findStoNum()">
'<input type="text" name="datestart" id="datepicker" style="width:80px" value="2014-05-09" class="hasDatepicker">
'<input type="submit" class="senddata" value="提交">
Option Explicit
Dim FormDLL As String, xDate As Date, Sh As Worksheet ', Msg As Boolean
Sub Ie_Table()
Dim URL As String, A As Object, i As Integer, E As Range
Set_FormDLL
URL = "http://stocker.com.tw/"
xDate = Date - 1
If Weekday(xDate, vbMonday) > 5 Then
Do While Weekday(xDate, vbMonday) > 5
xDate = xDate - 1
Loop
End If
Set Sh = Sheets.Add '結果顯示在新增的工作表
Sh.Name = Format(xDate, "yyyy-mm-dd") '命名為日期
With CreateObject("InternetExplorer.Application")
.navigate URL
.Visible = True
For Each E In Sheets("下載代號名單").Range("A3", Sheets("下載代號名單").[A3].End(xlDown))
Do While .Busy Or .ReadyState <> 4: Loop
With .document.getElementsByTagName("input")
.Item("StoNum").Value = E
.Item("datestart").Value = Format(xDate, "yyyy-mm-dd")
For i = 0 To .Length - 1
If .Item(i).Type = "submit" Then .Item(i).Click
Next
End With
Do While .Busy Or .ReadyState <> 4: Loop
Set A = .document.getElementsByTagName("TABLE")
Ep A(A.Length - 1).outerHTML
Next
.Quit
End With
Remove_FormDLL
End Sub
Sub Ep(S As String)
Dim D As New DataObject, E As Shape
'DataObject 物件在進行轉換動作時，做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
'宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入新增引用 Microsoft Forms 2.0 Object Library ,專案加入一表單即可
With D
.SetText S
.PutInClipboard
With Sh.UsedRange
If .Rows.Count = 1 Then
.Cells(1).Select
Else
.Rows(.Rows.Count).Cells(2).Select
End If
Sh.PasteSpecial Format:="Unicode 文字"
With ActiveCell
.Cells(2, 1) = "日期"
.Cells(3, 1).Resize(.Parent.UsedRange.Rows.Count - .Cells(3, 1).Row) = Format(xDate, "mm/dd")
End With
End With
End With
End Sub
Sub Set_FormDLL() '新增引用 Microsoft Forms 2.0 Object Library
On Error Resume Next
FormDLL = "FM20.DLL"
ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\FM20.DLL"
'"C:\windows\system32\"是2003版的路徑,2003以上版本需修改路徑
End Sub
Sub Remove_FormDLL() '刪除引用 Microsoft Forms 2.0 Object Library
Dim D As Object
For Each D In ThisWorkbook.VBProject.References
If UCase(D.fullpath) Like "*" & FormDLL Then
ThisWorkbook.VBProject.References.Remove D
End If
Next
End Sub

複製代碼

作者: jak 時間: 2014-5-18 19:55

回復 44# GBKEE

太神了，下載又快又穩，感謝大大幫忙，
還有抓下來的結果A欄是"日期"，有沒有辦法改成該公司的"代號"呢？

作者: GBKEE 時間: 2014-5-19 13:55

本帖最後由 GBKEE 於 2014-5-25 16:31 編輯

回復 45# jak

Sub Ie_Table()
Ep A(A.Length - 1).outerHTML, E '修改一下
End Sub

複製代碼

Sub Ep(S As String, Code As Range)
Dim D As New DataObject ', E As Shape
'DataObject 物件在進行轉換動作時，做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
'宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入新增引用 Microsoft Forms 2.0 Object Library ,專案加入一表單即可
With D
.SetText S
.PutInClipboard
With Sh.UsedRange
If .Rows.Count = 1 Then
.Cells(1).Select
Else
.Rows(.Rows.Count).Cells(2).Select
End If
Sh.PasteSpecial Format:="Unicode 文字"
With ActiveCell
.Cells(2, 1) = "代號"
.Cells(3, 1).Resize(.Parent.UsedRange.Rows.Count - .Cells(3, 1).Row) = Code
End With
End With
End With
End Sub

複製代碼

作者: jak 時間: 2014-5-24 19:10

本帖最後由 jak 於 2014-5-24 19:11 編輯

回復 46# GBKEE
大大不好意思，這麼晚才回文，修改後執行出現錯誤，可以請大大看一下我哪裡放錯嗎？感謝

Option Explicit
Dim FormDLL As String, xDate As Date, Sh As Worksheet ', Msg As Boolean
Sub Ie_Table()
Dim URL As String, A As Object, i As Integer, E As Range
Set_FormDLL
URL = "http://stocker.com.tw/"
xDate = Date - 1
If Weekday(xDate, vbMonday) > 5 Then
Do While Weekday(xDate, vbMonday) > 5
xDate = xDate - 1
Loop
End If
Set Sh = Sheets.Add '結果顯示在新增的工作表
Sh.Name = Format(xDate, "yyyy-mm-dd") '命名為日期
With CreateObject("InternetExplorer.Application")
.navigate URL
.Visible = True
For Each E In Sheets("下載代號名單").Range("A3", Sheets("下載代號名單").[A3].End(xlDown))
Do While .Busy Or .ReadyState <> 4: Loop
With .document.getElementsByTagName("input")
.Item("StoNum").Value = E
.Item("datestart").Value = Format(xDate, "yyyy-mm-dd")
For i = 0 To .Length - 1
If .Item(i).Type = "submit" Then .Item(i).Click
Next
End With
Do While .Busy Or .ReadyState <> 4: Loop
Set A = .document.getElementsByTagName("TABLE")
Ep A(A.Length - 1).outerHTML, E '修改一下
Next
.Quit
End With
Remove_FormDLL
End Sub
Sub Ep(S As String, Code As StdFont)
Dim D As New DataObject, E As Shape
'DataObject 物件在進行轉換動作時，做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
'宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入新增引用 Microsoft Forms 2.0 Object Library ,專案加入一表單即可
With D
.SetText S
.PutInClipboard
With Sh.UsedRange
If .Rows.Count = 1 Then
.Cells(1).Select
Else
.Rows(.Rows.Count).Cells(2).Select
End If
Sh.PasteSpecial Format:="Unicode 文字"
With ActiveCell
.Cells(2, 1) = "代號"
.Cells(3, 1).Resize(.Parent.UsedRange.Rows.Count - .Cells(3, 1).Row) = Code
End With
End With
End With
End Sub
Sub Set_FormDLL() '新增引用 Microsoft Forms 2.0 Object Library
On Error Resume Next
FormDLL = "FM20.DLL"
ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\FM20.DLL"
'"C:\windows\system32\"是2003版的路徑,2003以上版本需修改路徑
End Sub
Sub Remove_FormDLL() '刪除引用 Microsoft Forms 2.0 Object Library
Dim D As Object
For Each D In ThisWorkbook.VBProject.References
If UCase(D.fullpath) Like "*" & FormDLL Then
ThisWorkbook.VBProject.References.Remove D
End If
Next
End Sub

複製代碼

作者: GBKEE 時間: 2014-5-25 16:33

回復 47# jak
不好意思,最近常犯錯.46#的程式碼已更新

Sub Ep(S As String, Code As Range)

複製代碼

作者: jak 時間: 2014-5-25 19:19

回復 48# GBKEE
大大客氣了，要說不好意思的是我，這樣勞煩大大，
可以執行，結果就是我想像很久的樣子(按N個讚)，太感謝了 ~~~

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