[發問] 如何用vba執行網頁選擇檔案的功能?

網址:

https://www.pinkoi.com/

複製代碼

這個網站可以直接用fb登入
註冊之後會有信件,打開信件有個地方可以選擇檔案如圖片

如同麻辣家族的附件的選擇檔案也是一樣,按下去之後都會停止動作,除非手動關閉該視窗,請問有如何解決這個問題呢?

但程式一旦.Click 這個選擇檔案的按鈕之後就無法動作了
必須要手動關閉該視窗才可以繼續動作
請問要如何解決這個問題呢?

PS:許多網站都有相同的這個問題,還請各位大大幫忙解決

樓主熱帖

PKKO

　暱稱: PKKO

高中生 Rank: 3 Rank: 3

帖子: 549
主題: 152
精華: 0
積分: 691
點名: 0
作業系統: WIN7
軟體版本: OFFICE 2010
閱讀權限: 50
性別: 男
註冊時間: 2013-8-10
最後登錄: 2022-9-7

論壇榮譽勳章論壇贊助勳章

2^#

發表於 2017-1-4 18:19 | 顯示全部帖子

Sub test()
'PS:要自己先用ie開啟https://www.pinkoi.com/網址
'並且用FB點選登入,不然下列語法將會找不到傳送訊息的部分,要有登入才可傳送訊息給別人
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https://www.pinkoi.com/user/testpkko"
Do While IE.Busy Or IE.readyState <> 4: DoEvents: Loop
With IE.Document
i = 0: On Error Resume Next
For Each E In .GetElementsByTagName("A")
A = E.Text
If CStr(A) = "傳送訊息" Then
E.Click '這邊呼叫出傳送訊息的視窗
'要如何控制該視窗輸入主旨+內文+選擇檔案呢?
Call WEB_DETAIL(IE) '我用網頁元素的部分無法查不出相關資訊
End If
Next
End With
End Sub

複製代碼

Sub WEB_DETAIL(IE)
With IE
Do While .Busy Or .readyState <> 4: DoEvents: Loop
With .Document
i = 0: On Error Resume Next
For Each E In .ALL
i = i + 1
Cells(i, "a") = E.tagname
Cells(i, "b") = E.ID
Cells(i, "c") = E.Name
Cells(i, "d") = E.Value
Cells(i, "e") = E.innertext
Cells(i, "f") = E.Type
Cells(i, "g") = E.href
Cells(i, "H") = E.Text
Next
End With
End With
End Sub

複製代碼

PKKO

TOP

PKKO

　暱稱: PKKO

高中生 Rank: 3 Rank: 3

帖子: 549
主題: 152
精華: 0
積分: 691
點名: 0
作業系統: WIN7
軟體版本: OFFICE 2010
閱讀權限: 50
性別: 男
註冊時間: 2013-8-10
最後登錄: 2022-9-7

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2017-1-5 14:59 | 顯示全部帖子

本帖最後由 PKKO 於 2017-1-5 15:01 編輯

我已經把完整的登入程式碼以及跳出表單的程式碼都完成
但是要如何才能夠將跳出的表單輸入主旨和內文以及選擇檔案並且寄出資料呢?

Sub test()
Dim ie As Object 'SHDocVw.InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
Call login(ie) 'just for login
Call show_the_form(ie) 'My problem in here
End Sub
Sub login(ie)
ie.Visible = True
ie.Navigate "https://www.pinkoi.com/user/testpkko"
Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop
Dim anchorTags As Object 'MSHTML.IHTMLElementCollection
Set anchorTags = ie.document.GetElementsByTagName("A")
Dim oAnchorLoop As Object 'MSHTML.IHTMLAnchorElement
For Each oAnchorLoop In anchorTags
Dim anchorText As String
anchorText = oAnchorLoop.Text
If anchorText = ChrW(20659) & ChrW(36865) & ChrW(35338) & ChrW(24687) Then
Dim oAnchorLogon As Object 'MSHTML.IHTMLAnchorElement2
Set oAnchorLogon = oAnchorLoop
oAnchorLogon.Click
Exit For
End If
Next
Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop
'* so now logon form should be visible
On Error Resume Next
Dim oUserNameInput As Object 'MSHTML.IHTMLInputElement
Set oUserNameInput = ie.document.getElementById("n-login-id")
nowtime = Timer
Do While ie.Busy Or ie.readyState <> 4 Or oUserNameInput Is Nothing
DoEvents
If Timer - nowtime > 1 Then Exit Do 'Already logoin
Set oUserNameInput = ie.document.getElementById("n-login-id")
Loop
oUserNameInput.Value = "testpkko"
Dim oUserPassword As Object 'MSHTML.IHTMLInputElement
Set oUserPassword = ie.document.getElementById("n-login-password")
oUserPassword.Value = "abc123"
Dim oListElement As Object 'MSHTML.HTMLLIElement
Set oListElement = oUserNameInput.parentElement
Dim oUnorderedList As Object 'MSHTML.IHTMLUListElement
Set oUnorderedList = oListElement.parentElement
Dim oForm As Object 'MSHTML.IHTMLFormElement
Set oForm = oUnorderedList.parentElement
Dim oSubmitInputElememt As Object 'MSHTML.HTMLInputElement
Set oSubmitInputElememt = Nothing
Dim lFormChildrenLoop As Long
For lFormChildrenLoop = 1 To oForm.all.Length
If oForm.elements.Item(lFormChildrenLoop).Type = "submit" Then
Set oSubmitInputElememt = oForm.elements.Item(lFormChildrenLoop)
Exit For
End If
Next lFormChildrenLoop
If Not oSubmitInputElememt Is Nothing Then
'Stop '* get ready .....
oSubmitInputElememt.Click
Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop
End If
End Sub
Sub show_the_form(ie)
Application.Wait Now + TimeValue("00:00:03")
ie.Navigate "https://www.pinkoi.com/user/testpkko2" 'After login we can trip to other people website
Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop
With ie.document
On Error Resume Next
For Each E In .GetElementsByTagName("A")
a = E.Text
If CStr(a) = "傳送訊息" Then
E.Click '這邊會跳出寄送的表單,要如何輸入主旨以及內文和選擇檔案並按下寄送按鈕呢?
End If
Next
End With
End Sub