iT邦幫忙

1

vba自動儲存網頁檔案

下載程式碼
msmplayv121068 2018-03-28 19:57:09 ‧ 15699 瀏覽

  • 分享至 

  • xImage

請問如何讓以下程式碼，執行到檔案下載的時候，自動儲存檔案至同資料夾並保持原檔名.csv檔(下載檔案為.csv檔)

Sub 查詢每日數據並下載檔案()
Dim indexer As Integer
indexer = 6656 + Day(Now()) - 23

Set myIE = CreateObject("InternetExplorer.Application")
With myIE
.Visible = true
.Navigate "http://xxxxxxxxxxxx/xxx.aspx" '查詢數據網址

Do While .ReadyState <> 4
DoEvents
Loop

.Navigate "javascript:__doPostBack('ct600$phCondition3$cldDate','" & indexer & "')"
Application.Wait Now + 2 / 86400 '等待2秒
.document.forms(0).all("ct600_btnConfirm").Click '點選查詢按鈕

.Navigate "http://10.178.1.140:8023/ReportPage/ReportAgentToDay_28_tptv.aspx" '查詢數據會自動產生於此網址頁面

Do Until .ReadyState = 4
DoEvents
Loop

.document.forms(0).all("ctl00_btnDownload").Click '點選下載按鈕

'點選下載按鈕後，網頁會彈出下載檔案視窗，詢問"開啟舊檔"、"儲存"、"取消"選項
'希望能自動儲存至同資料夾並保持原檔名.csv檔(下載檔案為.csv檔)
'請問以上這段程式碼該怎麼寫呢？

End With
End Sub

登入發表討論
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

2 個回答

0
marlin12
iT邦研究生 5 級 ‧ 2018-03-29 23:46:38
最佳解答

要用vba去控制IE的[下載檔案視窗]，是比較困難。但是，如果下載的是csv檔案，就可以用excel代勞。

假設vba源代碼是在excel檔案裏，你可以跟隨以下的步驟，去自動下載和儲存那個csv檔案：

  1. 當下載表格出現在網址後，不要點選[下載按鈕]，而是要去取得下載的url。即是用
Dim csvUrl As String 
csvUrl =myIE.document.forms(0).all("ct600_btnConfirm").getAttribute("href")

去取代

myIE.document.forms(0).all("ct600_btnConfirm").Click
  1. 然後，就可以用excel去打開那個csv檔案。
Workbook csvBook = Application.Workbooks.Open(csvUrl)
  1. 通常這個下載檔案都是唯讀的，你可以把它另存副本為一個相同名稱、但不同資料夾路徑的檔案。這裏就選用了這個有vba代碼的excel檔案的路徑。
   Dim csvFullName As String
   csvFullName = ThisWorkbook.Path & "\" & .Name
   csvBook.SaveCopyAs Filename:=csvFullName
  1. 最後就可以關閉那個唯續的檔案。
csvBook.Close

把上面的4個步驟合起來，便可以得出以下的源代碼：

Dim csvUrl As String 
csvUrl =myIE.document.forms(0).all("ct600_btnConfirm").getAttribute("href")

Application.DisplayAlerts = False
    
With Application.Workbooks.Open(csvUrl)
    Dim csvFullName As String
    csvFullName = ThisWorkbook.Path & "\" & .Name
    .SaveCopyAs Filename:=csvFullName
    .Close
End With
    
Application.DisplayAlerts = True
看更多先前的回應...收起先前的回應...
msmplayv121068 iT邦新手 4 級 ‧ 2018-03-30 08:38:27 檢舉

marlin12大~~非常感謝幫忙，但目前遇到以下問題：
你指的取得下載的url
Dim csvUrl As String
csvUrl =myIE.document.forms(0).all("ct600_btnConfirm").getAttribute("href")
中間應該是ctl00_btnDownload，不是ct600_btnConfirm對ㄇ！？

然後我將程式碼放在Navigate "http://10.178.1.140:8023/ReportPage/ReportAgentToDay_28_tptv.aspx" '查詢數據會自動產生於此網址頁面下面ㄧ行執行出現錯誤訊息
「執行階段錯誤'94':Null 的使用不正確」
可以再請你幫看是不是哪裡出現問題呢？非常感謝~~~~~~

Sub 查詢每日數據並下載檔案()
Dim indexer As Integer
indexer = 6656 + Day(Now()) - 23

Set myIE = CreateObject("InternetExplorer.Application")
With myIE
.Visible = true
.Navigate "http://xxxxxxxxxxxx/xxx.aspx" '查詢數據網址

Do While .ReadyState <> 4
DoEvents
Loop

.Navigate "javascript:__doPostBack('ct600$phCondition3$cldDate','" & indexer & "')"
Application.Wait Now + 2 / 86400 '等待2秒
.document.forms(0).all("ct600_btnConfirm").Click '點選查詢按鈕

.Navigate "http://10.178.1.140:8023/ReportPage/ReportAgentToDay_28_tptv.aspx" '查詢數據會自動產生於此網址頁面

Do Until .ReadyState = 4
DoEvents
Loop

Dim csvUrl As String
csvUrl =myIE.document.forms(0).all("ctl00_btnDownload").getAttribute("href")

Application.DisplayAlerts = False

With Application.Workbooks.Open(csvUrl)
Dim csvFullName As String
csvFullName = ThisWorkbook.Path & "" & .Name
.SaveCopyAs Filename:=csvFullName
.Close
End With

Application.DisplayAlerts = True

End With
End Sub

marlin12 iT邦研究生 5 級 ‧ 2018-03-30 19:41:57 檢舉

可能csv檔案的url，根本不在ctl00_btnDownload個按鍵裏面。
另一個方法是用vba的SendKeys，把對應於不同[彈出視窗]的按鍵，直接傳到Internet Explorer。
但是這個方法有一個很大的限制，就是用vba打開的Internet Explorer，必須是active window，直到代碼運行完畢為止。即是說，[查詢每日數據並下載檔案]的代碼，只可以用excel的[巨集]或者[自建按鍵]去呼叫，並且要關閉excel的[除錯視窗]，否則按鍵就會傳回去[除錯視窗]。

Sub 查詢每日數據並下載檔案()
	Set myIE = CreateObject("InternetExplorer.Application")
	With myIE
		.Visible = True
		.Navigate "http://xxxxxxxxxxxx/xxx.aspx" '查詢數據網址
		Do Until .ReadyState = READYSTATE_COMPLETE
			DoEvents
		Loop

		Dim indexer As Integer
		indexer = 6656 + Day(Now()) - 23
		.Navigate "javascript:__doPostBack('ct600$phCondition3$cldDate','" & indexer & "')"
		Application.Wait Now + TimeValue("0:00:2") '延遲2秒
		.document.forms(0).all("ct600_btnConfirm").Click '點選查詢按鈕

		.Navigate "http://10.178.1.140:8023/ReportPage/ReportAgentToDay_28_tptv.aspx" '查詢數據會自動產生於此網址頁面
		Do Until .ReadyState = READYSTATE_COMPLETE
			DoEvents
		Loop

		.document.forms(0).all("ctl00_btnDownload").Click '點選下載按鈕
	End With
	
	' 回應[如何處理]視窗
	Application.Wait Now + TimeValue("0:00:2") '延遲2秒
	Application.SendKeys "%{A}"     ' <alt-A> 按[另存新檔]鍵
    
	' 回應[另存新檔]視窗
	Application.Wait Now + TimeValue("0:00:2") '延遲2秒
	Application.SendKeys "%{N}"     ' <alt-N> 選取[檔案名稱]欄位
	Application.SendKeys "{HOME}" & ThisWorkbook.Path & "\"  ' 設定存檔路徑
	Application.SendKeys "%{S}"     ' <alt-S> 按[存檔]鍵
    
	' 回應[確認另存新檔]視窗
	Application.Wait Now + TimeValue("0:00:2") '延遲2秒
	Application.SendKeys "%{Y}"     ' <alt-Y> 按[是]鍵 (如果同名檔已經存在)
    
	' 回應[檢視下載]視窗
	Application.Wait Now + TimeValue("0:00:5") '延遲5秒
	Application.SendKeys "%{C}"     ' <alt-C> 按[關閉]鍵
	
	myIE.Quit
	Set myIE = Nothing
End Sub

如何處理 視窗
另存新檔 視窗
確認另存新檔 視窗
檢視下載 視窗

msmplayv121068 iT邦新手 4 級 ‧ 2018-04-09 19:00:38 檢舉

marlin12大非常感謝幫忙~已解決問題~~超強的你

msmplayv121068 iT邦新手 4 級 ‧ 2018-12-12 15:10:49 檢舉

marlin12大~~~~
我最近遇到一個挺困擾我的問題，不知道能不能再跟你請教一下。
就是上面曾向你請教過的下載檔案問題，使用SendKeys來回應[如何處理]視窗，也就是回應[檔案下載]的那個視窗。

下載檔案都沒有問題，但因為[檔案下載]視窗彈出的等待時間長短不固定，有時候很快約１０秒，有時候卻要等到１分鐘以上。

因為公司的系統問題，導致每次設好延遲時間，都會因為太快或太慢向下繼續執行，而造成下載連線異常導致下載失敗。

所以想請問在以下延遲時間這段語法，是否有辦法改為判斷檔案下載視窗是否已彈出，再繼續往下執行的語法呢？有這種解決辦法嗎？

' 回應[如何處理]視窗
** Application.Wait Now + TimeValue("0:00:2") '延遲2秒**

登入發表回應
0
snoopy98798
iT邦見習生 ‧ 2018-07-17 19:58:17

您好，謝謝樓上大大您熱心幫忙，最近也遇到與原po類似的問題故回應於此篇，我照著大大上面寫另存新檔的程式碼控制時遇到檔名要存成每日日期問題。
請問我要下載的是EXCEL檔的話，另存新檔時若檔名要存成"AcSIN-今日日期"(例:AcSIN-20180717)
而存檔路徑是
ThisWorkbook.Path & "\data資料夾"
要如何控制呢？

以下是我試著寫的程式碼
Application.SendKeys "%{N}" & "AcSIN-" & format(date,yyyymmdd)
Application.SendKeys "{HOME}" & ThisWorkbook.Path & "\data資料夾"
Application.SendKeys "%{S}"
卻一直出現"找不到檔案"警告視窗無法讓我存檔，想請問該怎麼改進，謝謝您

登入發表回應

我要發表回答

立即登入回答
iThome鐵人賽
參賽組數
1064 組
團體組數
40 組
累計文章數
22211 篇
完賽人數
602 人
iT+看影片追技術 看影片追技術 看更多
熱門tag 看更多
15th鐵人賽 16th鐵人賽 13th鐵人賽 14th鐵人賽 12th鐵人賽 11th鐵人賽 鐵人賽 2019鐵人賽 javascript 2018鐵人賽 python 2017鐵人賽 windows php c# windows server linux css react vue.js
熱門問題
熱門回答
熱門文章
IT邦幫忙