Question

互联网的大家好！如标题所示，最近我的vba代码遇到了一些问题。更具体地说，我对以下函数进行了编码，该函数获取一组日期作为输入，然后从网站下载并打开相应的excel工作簿，一次一次，复制特定范围，并将其粘贴到thisWorkbook然后关闭下载的工作簿。

Public Function henexDownload(ByRef auctionDates() As Date, ByVal firstEmptyRow As Long)
Const lagieURL = "http://www.lagie.gr/fileadmin/user_upload/reports/DayAheadSchedulingResults/"
Const henexURL = "http://www.enexgroup.gr/fileadmin/user_upload/reports/DayAheadSchedulingResults/"
Dim tempRNG As Range
Dim tempWorkbook As Workbook
Dim requestURL As String
Dim fileName As String
Dim d As Integer
Dim i As Long
Dim j As Long
Set tempRNG = ThisWorkbook.Worksheets("Prices").Cells.Find(What:="HENEX", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
j = tempRNG.Column
For d = LBound(auctionDates) To UBound(auctionDates)
    i = firstEmptyRow
    fileName = Format(auctionDates(d), "yyyymmdd") + "_DayAheadSchedulingResults_01.xls"
    If Year(auctionDates(d)) >= 2018 Then
        requestURL = henexURL + fileName
    Else
        requestURL = lagieURL + fileName
    End If
    If URLExists(requestURL) Then
        Set tempWorkbook = Workbooks.Open(requestURL)
        tempWorkbook.Worksheets(1).Range("C7:Y7").Copy
        ThisWorkbook.Worksheets("Prices").Cells(i, j).PasteSpecial xlPasteValues, Transpose:=True
        tempWorkbook.Close (False)
    Else
        MsgBox "The requested file:" + vbNewLine + vbNewLine + fileName + vbNewLine + vbNewLine + "is not available.", vbCritical
    End If
    firstEmptyRow = firstEmptyRow + 24
    'ThisWorkbook.Save
Next d
End Function

该代码完全可以按预期工作，最多可以进行随机的迭代。我第一次观察到此问题，这个数字是15。该代码将在第16次迭代时始终崩溃，并显示一条消息，“抱歉，我们无法打开....”，其中...是文件的url。在互联网上进行了一些研究之后，我遇到了一些看起来相似的问题。在这些情况下，有人建议应不时保存一次工作簿，以便刷新excel的缓存。我没有运气尝试过。重新启动我的电脑似乎通常会在代码崩溃之前增加迭代次数，但仍然会随机崩溃。应该注意的是，崩溃并不取决于文件是否存在。它似乎只与正在处理的文件数有关。这可能是与内存相关的问题吗？可能与临时文件有关吗？任何建议将不胜感激。

URLExists函数如下：

Public Function URLExists(url As String) As Boolean 'checks if the URL actually exists
    Dim request As Object
    Dim ff As Integer
    Dim rc As Variant

    On Error GoTo endNow
    Set request = CreateObject("WinHttp.WinHttpRequest.5.1")

    With request
      .Open "GET", url, False
      .Send
      rc = .StatusText
    End With
    Set request = Nothing
    If rc = "OK" Then URLExists = True

    Exit Function
endNow:
End Function

下载并打开多个Excel文件后，Excel VBA方法workbooks.open失败

0 个答案: