有關EXCEL VBA 抓取不到完整網址CSV問題
- 帖子
- 48
- 主題
- 6
- 精華
- 0
- 積分
- 60
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-8-13
- 最後登錄
- 2023-2-7
|
|
很抱歉,我是小學生,不能下載檔案,是個小屁孩!
|
|
|
|
|
- 帖子
- 11
- 主題
- 2
- 精華
- 0
- 積分
- 14
- 點名
- 0
- 作業系統
- xp
- 軟體版本
- 2007
- 閱讀權限
- 10
- 註冊時間
- 2011-9-17
- 最後登錄
- 2017-4-24
|
42#
發表於 2014-3-3 14:47
| 只看該作者
|
|
|
|
|
|
- 帖子
- 36
- 主題
- 7
- 精華
- 0
- 積分
- 76
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-10-1
- 最後登錄
- 2016-3-21
|
43#
發表於 2014-3-6 11:38
| 只看該作者
回復 jak
GBKEE 發表於 2013-11-17 09:42 
若是我想copy下列網址某天、某幾家的資料,http://stocker.com.tw/
可否請大大撥冗幫忙,有附檔 |
-
-
明細.rar
(5.16 KB)
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
44#
發表於 2014-5-15 16:11
| 只看該作者
抱歉,沒有注意到,久等了.
試試看- <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
複製代碼 |
|
|
|
|
|
|
- 帖子
- 36
- 主題
- 7
- 精華
- 0
- 積分
- 76
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-10-1
- 最後登錄
- 2016-3-21
|
45#
發表於 2014-5-18 19:55
| 只看該作者
回復 44# GBKEE
太神了,下載又快又穩,感謝大大幫忙,
還有抓下來的結果A欄是"日期",有沒有辦法改成該公司的"代號"呢? |
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
46#
發表於 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
複製代碼 |
|
|
|
|
|
|
- 帖子
- 36
- 主題
- 7
- 精華
- 0
- 積分
- 76
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-10-1
- 最後登錄
- 2016-3-21
|
47#
發表於 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
複製代碼 |
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
48#
發表於 2014-5-25 16:33
| 只看該作者
回復 47# jak
不好意思,最近常犯錯.46#的程式碼已更新- Sub Ep(S As String, Code As Range)
複製代碼 |
|
|
|
|
|
|
- 帖子
- 36
- 主題
- 7
- 精華
- 0
- 積分
- 76
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-10-1
- 最後登錄
- 2016-3-21
|
49#
發表於 2014-5-25 19:19
| 只看該作者
回復 48# GBKEE
大大客氣了,要說不好意思的是我,這樣勞煩大大,
可以執行,結果就是我想像很久的樣子(按N個讚),太感謝了 ~~~ |
|
|
|
|
|
|