- 帖子
- 55
- 主題
- 1
- 精華
- 0
- 積分
- 81
- 點名
- 0
- 作業系統
- win
- 軟體版本
- 10
- 閱讀權限
- 20
- 註冊時間
- 2016-5-15
- 最後登錄
- 2018-11-1
|
3#
發表於 2016-5-18 19:37
| 只看該作者
今天有在試了一個方式 SendKeys
可以存檔案下來，但key入的名字，常常跑不完全（因為要跑五個網頁，一個一個跑，跑五次，如果反覆一直按，每次存的名字要看運氣才會正確也）- Sub 下載pdf()
- Sheets("下載用").Select
-
- Dim xlsName, xlsNameNo, MyName, NewName, SavePath, DDate, URL As String
- xlsName = ActiveWorkbook.Name ''檔名
- xlsNameNo = Mid(xlsName, 1, 4) ''檔名前4字元
- SavePath = ActiveWorkbook.Path ''路徑
- MyName = Application.ActiveWorkbook.FullName ''路徑檔名
- NewName = Left(MyName, Len(MyName) - 5) ''去除副檔名
- DDate = Format(Date, "yyyy-mm-dd _ ") ''當日日期
-
-
- Cells.Clear
- Application.DisplayStatusBar = True
- Application.ScreenUpdating = False
- ''董監持股現況1
- Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
- URL = "http://www.fortunengine.com.tw/stock/company/holding.cfm?scode=" & xlsNameNo ''網址
- With ie
- .Visible = False 'True為開啟ie, False為不開啟ie
- .Navigate URL
-
- Do While .Busy: DoEvents: Loop
- Do While .Busy: DoEvents: Loop
- Do While .Readystate <> 4: DoEvents: Loop
- .ExecWB 6, 2
-
-
- Application.Wait Now + TimeValue("00:00:04")
- Application.SendKeys (DDate & xlsNameNo & "_1")
- ''Application.Wait Now + TimeValue("00:00:01")
- Application.SendKeys "{TAB}", True
- ''Application.Wait Now + TimeValue("00:00:01")
- Application.SendKeys "{TAB}", True
- ''Application.Wait Now + TimeValue("00:00:01")
- Application.SendKeys "{TAB}", True
- ''Application.Wait Now + TimeValue("00:00:01")
- Application.SendKeys "{ENTER}", True
- ''Application.Wait Now + TimeValue("00:00:01")
- Application.SendKeys "{TAB}", True
- Application.SendKeys "{ENTER}", True
-
- End With
-
- Application.StatusBar = False
- ie.Quit
- End Sub
|
|
