Как автоматизировать сохранение файла из Internet Explorer 11 в VBA на 64-битной машине

Question

У вас есть файл Excel по этому адресу: https://ufr.osd.state.ma.us/DM/GetDoc.aspx?DocId=165350&Library=EFILEDMProd

Вверху вы можете увидеть гиперссылку с названием «Скачать».Необходимо автоматизировать сохранение этого файла с помощью VBA в Excel через Internet Explorer 11 на 64-разрядной машине.В идеале я также хотел бы сохранить файл по определенному пути и с определенным именем файла (в данном случае "2018-042389332.xls").Проблема в том, что я не могу найти способ прямой загрузки файла, поэтому мне остается разобраться с диалоговым окном «Сохранить файл», с которым сложно взаимодействовать.До сих пор я пытался использовать SendKeys с противоречивыми результатами.

Вот соответствующая часть кода, который я использую.Пока что работает нажатие на кнопку «Загрузить», в нижней части открывается диалоговое окно «Сохранить файл», а в некоторых случаях выполняется сохранение файла в качестве имени файла по умолчанию.

    IE.Document.getElementById("LinkButton2").Click
    SendKeys "{F6}", True
    SendKeys "{TAB}", True
    SendKeys "{DOWN}", True
    SendKeys "{DOWN}", True
    SendKeys "{ENTER}", True

    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{ENTER}", True

Answer 1

Чтобы получить более последовательные результаты, я бы постарался подождать секунду после каждого ключа отправки, попробуйте вставить это после каждого ключа отправки:

Application.Wait (Now + TimeValue("0:00:01"))

Вам нужно использовать Internet Explorer? Если у вас есть прямая ссылка для скачивания, это будет намного проще

Dim HttpReq As Object, myURL As String
Set HttpReq = CreateObject("Microsoft.XMLHTTP")
    myURL = *direct download link*
    HttpReq.Open "GET", myURL, False, "", ""
    HttpReq.send
    myURL = HttpReq.responseBody
    If HttpReq.Status = 200 Then
        Set oStrm = CreateObject("ADODB.Stream")
        oStrm.Open
        oStrm.Type = 1
        oStrm.Write HttpReq.responseBody
        oStrm.SaveToFile *File Path with file name and extension*,1 ' 1 = no overwrite, 2 = overwrite
        oStrm.Close
    End If

Answer 2

Вместо взаимодействия с диалоговым окном файла, заставьте IE загрузить файл напрямую.Затем используйте функцию, которая возвращает имя самого последнего файла в папке (папка загрузки IE), чтобы вы знали, какой из них является файлом, который вы только что загрузили.

Function LatestFile(StrDefaultFolder As String) As String

Dim LatestDate As Date

StrCurrentFile = Dir(StrDefaultFolder)

Do While Len(StrCurrentFile) > 0

    StrFullFileName = StrDefaultFolder & StrCurrentFile

    If FileDateTime(StrFullFileName) > LatestDate Then
        LatestDate = FileDateTime(StrFullFileName)
        LatestFile = StrCurrentFile
    End If

    StrCurrentFile = Dir
Loop

End Function

Теперь вы можете копировать, вставлять и переименовыватьфайл как вам нравится:

Sub MoveAndRenameFile()

StrLastFile = LatestFile("C:\Users\YourUserName\Downloads\")

Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile StrLastFile, "C:\SomeFolder\NewFilename.xlsx"

End Sub

Answer 3

вам нужно использовать URLDownloadToFile для прямой загрузки файла с использованием кода VBA.

Вот пример кода, который вы пытаетесь запустить непосредственно из модуля Excel VBA.

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Sub download_HK_picture()
imgsrc = "https://dornsife.usc.edu/assets/sites/298/docs/ir211wk12sample.xls"
dlpath = "C:\"
URLDownloadToFile 0, imgsrc, dlpath & "ir211wk12sample.xls", 0, 0
End Sub

Кроме того, вы можете изменить код в соответствии с вашими требованиями.

Справка:

(1) Загрузка файлов с VBA URLDownloadToFile