Question

我正在编写一个自动从URL下载excel的脚本。我面临的问题是对话框出现的时间不固定，所以我不能硬编码等待时间。我需要一个代码，它会等到对话框出现，然后单击“另存为”按钮。提前致谢

Answer 1

我不确定您指的是哪种对话框，但这里有几个脚本可以从网上下载文件。

把它放在单元格A1中： http://www.math.smith.edu/r/data/help.xlsx

将它放在单元格B1中： C：\ Users \ user \ Desktop \或要将文件下载到

的路径

把它放在单元格C1中：文件下载成功！

运行此代码。

Private Declare 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

Private Sub pMain()
  Dim sURL As String
  Dim sDestination As String
  Dim bSuccess As Boolean
  Dim lRow As Long
  Dim ws As Excel.Worksheet
  Dim strSavePath As String
  Dim URL As String, ext As String
  Dim buf, ret As Long

  'Change to suit
  Set ws = ThisWorkbook.Worksheets("Sheet1")

  With ws
    For lRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
      sURL = .Cells(lRow, "A")
      sDestination = .Cells(lRow, "B")

      buf = Split(sURL, ".")
      ext = buf(UBound(buf))

        pos = InStrRev(sURL, "/", -1)
        file = Mid(sURL, pos + 1, 99)
        strSavePath = sDestination & file
        ret = URLDownloadToFile(0, sURL, strSavePath, 0, 0)
            If ret = 0 Then
                .Cells(lRow, "C") = "File download successfully!"
            Else
                .Cells(lRow, "C") = "Couldn't download the file!"
            End If

      DoEvents
    Next lRow
  End With
End Sub

另外，试试这个......

私人声明功能URLDownloadToFile Lib＆＃34; urlmon＆＃34;别名_ ＆＃34; URLDownloadToFileA＆＃34; （ByVal pCaller As Long，ByVal szURL As String，ByVal _ szFileName As String，ByVal dwReserved As Long，ByVal lpfnCB As Long）As long

Sub DownloadFilefromWeb()
    Dim strSavePath As String
    Dim URL As String, ext As String
    Dim buf, ret As Long
    URL = Worksheets("Sheet1").Range("A2").Value
    buf = Split(URL, ".")
    ext = buf(UBound(buf))
    strSavePath = "C:\Users\your_path\Desktop\" & "DownloadedFile." & ext
    ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
    If ret = 0 Then
        MsgBox "Download has been succeed!"
    Else
        MsgBox "Error"
    End If
End Sub

Answer 2

感谢您花时间回答我的问题。

我终于找到了解决这个问题的方法。我使用了以下代码。

Dim website
website = "http://yoursite.com"
With IE
    .Visible = True
    .navigate website
End With

Application.Wait (Now + TimeValue("0:00:02"))
Cells(1, 1) = GetTitle
var = CheckTitle(Cells(1, 1))
Do While var = False
    Cells(1, 1) = GetTitle
    var = CheckTitle(Cells(1, 1))
Loop
Cells(1, 1) = ""

函数GetTitle（）

Dim ActiveWindowHandle As Long
'get the handle of the active window
ActiveWindowHandle = GetForegroundWindow()

Dim Title As String * 255

' get the title of the active window
GetWindowText ActiveWindowHandle, Title, Len(Title)
'MsgBox myString
GetTitle = Trim(Title)

结束功能

Function CheckTitle（checkval As String）As Boolean

If checkval <> "Internet Explorer" Then
    CheckTitle = False
    Application.Wait (Now + TimeValue("0:0:10"))
Else
    CheckTitle = True
End If

结束功能

等到VBA中出现“下载”对话框

2 个答案: