VBA - 从Internet Explorer的框架通知栏中选择另存为

时间:2017-05-20 20:52:30

标签: excel-vba internet-explorer web-scraping ui-automation save-as

我正在尝试通过Internet Explorer的框架通知栏下载保存文件。 但是,经过大量搜索,我只找到了解决方案,点击框架通知栏上的save。 到目前为止,我一直在尝试将其保存为示例站点上的文件:

http://www.tvsubtitles.net/subtitle-114117.html

使用以下代码:

' Add referenses
' Microsoft Internet Controls
' Microsoft HTML Object Library
' UIAutomationClient (copy file from C:\Windows\System32\UIAutomationCore.dll to Documents Folder)

#If VBA7 Then
    Private Declare PtrSafe Function FindWindowEx _
        Lib "user32" _
        Alias "FindWindowExA" ( _
        ByVal hWnd1 As LongPtr, _
        ByVal hWnd2 As LongPtr, _
        ByVal lpsz1 As String, _
        ByVal lpsz2 As String) _
        As LongPtr
#Else
    Private Declare Function FindWindowEx _
        Lib "user32" _
        Alias "FindWindowExA" ( _
        ByVal hWnd1 As Long, _
        ByVal hWnd2 As Long, _
        ByVal lpsz1 As String, _
        ByVal lpsz2 As String) _
        As Long
 #End If

Sub downloadfilefromeie()

    Dim subpage As InternetExplorer
    Dim objpage As HTMLDocument
    Dim o As CUIAutomation
    Dim h As LongPtr
    Dim fnb As LongPtr
    Dim e As IUIAutomationElement
    Dim iCnd As IUIAutomationCondition
    Dim Button As IUIAutomationElement
    Dim InvokePattern As IUIAutomationInvokePattern
    Dim strBuff As String
    Dim ButCap As String

    Set objshell = CreateObject("Shell.Application")
    Set objallwindows = objshell.Windows
    Set subpage = New InternetExplorer
    For Each ow In objallwindows
        'MsgBox ow
        If (InStr(1, ow, "Internet Explorer", vbTextCompare)) Then
            'MsgBox ow.Hwnd & "  " & ow & "   " & ow.locationURL
            If (InStr(1, ow.locationURL, "tvsub", vbTextCompare)) Then
                Set subpage = ow
            End If
        End If
    Next
    Set objpage = New HTMLDocument
    If subpage Is Nothing Then
    Else
        Set objpage = subpage.Document
        'Debug.Print objpage
        'objpage.getElementById("content").Click
        Set dl = objpage.getElementsbyclassname("subtable")
        Set dltable = dl(0).FirstChild.ChildNodes
        Set dlrow = dltable(10).getElementsByTagName("a")(2)
        dlrow.Click
        While objpage.ReadyState <> "complete"
            DoEvents
        Wend
    End If
    Application.Wait (Now() + TimeValue("0:00:05"))
    Set o = New CUIAutomation
    h = subpage.Hwnd
    fnb = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
    If fnb = 0 Then Exit Sub
    'Debug.Print "type of fnb is " & TypeName(fnb)
    Set e = o.ElementFromHandle(ByVal fnb)
    'Debug.Print "type of e is " & TypeName(e)
    Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
    Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
    'Debug.Print "type of Button is " & TypeName(Button)
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    'Debug.Print "type of InvokePattern is " & TypeName(InvokePattern)
    InvokePattern.Invoke

End Sub

我尝试将"Save"更改为"Save as",但它不起作用。我的猜测是,在访问“另存为”按钮之前,我需要先以某种方式点击分割按钮上的箭头,但我没有成功。 如果有人能提供解决方案,我很高兴。

1 个答案:

答案 0 :(得分:0)

我尝试只是通过链接http://www.tvsubtitles.net/download-114117.html下载文件,该链接可以在网页http://www.tvsubtitles.net/subtitle-114117.html上找到,它对我有用,这里是代码:

if (isset($_FILES['image']['name'])) {
    /***********************************************************
     * 1 - Upload Original Image To Server
     ***********************************************************/
    //Get Name | Size | Temp Location
    $ImageName = $_FILES['image']['name'];
    $ImageSize = $_FILES['image']['size'];
    $ImageTempName = $_FILES['image']['tmp_name'];

    //Get File Ext
    $ImageType = @explode('/', $_FILES['image']['type']);
    $type = $ImageType[1]; //file type
    //Set Upload directory
    $uploaddir = $_SERVER['DOCUMENT_ROOT'] . '/Halpper/';
    //Set File name
    $file_temp_name = $profile_id . '_original.' . md5(time()) . 'n' . $type; //the temp file name
    $fullpath = $uploaddir . "/" . $file_temp_name; // the temp file path
    $file_name = $profile_id . '_temp.jpeg'; //$profile_id.'_temp.'.$type; // for the final resized image
    $finalname = $profile_id . md5(time());
    $fullpath_2 = "assets/images/profile_pics/" . $finalname . "n.jpg"; //for the final resized image
    //Move the file to correct location
    if (move_uploaded_file($ImageTempName, $uploaddir . $fullpath_2)) {
        chmod($uploaddir . $fullpath_2, 0777);
    }
    //Check for valid uplaod
    if (!$move) {
        die ('File didnt upload');
    } else {
        $imgSrc = "assets/images/profile_pics/" . $file_name; // the image to display in crop area
        $msg = "Upload Complete!";   //message to page
        $src = $file_name;          //the file name to post from cropping form to the resize
    }
}