VBA檢查文件（來自網站）是否存在

Question

我是VBA的初學者，請多多包涵。

我正在嘗試使用VBA通過網站打開Excel文件。 文件的地址（路徑）逐月變化。 例如：

• 7月，文件名為： http : //www.clevelandfed.org/research/data/inflation_expectations/2014/July/excel1.xls

• 8月，文件名為： http : //www.clevelandfed.org/research/data/inflation_expectations/2014/August/excel1.xls

問題是我永遠都不知道該月的新文件什么時候發布。 因此，我需要在VBA代碼中簽入當前月份文件是否存在，否則，我只需要打開前一個月份文件即可。

這是我嘗試過的：

Dim DirFile As String
Dim wbA As Workbook

DirFile = "http://www.clevelandfed.org/research/data/inflation_expectations/" & Format(Now, "YYYY") & "/" & Format(Now, "MMMM") & "/excel1.xls"

' Check if the file for current month does not exist, open previous month's file
If Len(Dir(DirFile)) = 0 Then
    Set wbA = Workbooks.Open("http://www.clevelandfed.org/research/data/inflation_expectations/" & Format(Now, "YYYY") & "/" & Format(DateAdd("m", -1, Date), "MMMM") & "/excel1.xls", IgnoreReadOnlyRecommended:=True)

'If the current month file exists, open it
Else
    Set wbA = Workbooks.Open(DirFile, IgnoreReadOnlyRecommended:=True)
End If

但是，這會導致錯誤：

我認為這是由於這是一個駐留在網站上的文件。 誰能幫忙解決這個問題？

謝謝！

Answer 1

您假設Dir()對於網站上的文件不起作用是正確的

Dir函數返回一個String，該String表示與指定的模式或文件屬性匹配的文件，目錄或文件夾的名稱，或者驅動器的卷標。

您需要以下功能來檢查URL是否有效 ， PS將功能放在模塊中

Function URLExists(url As String) As Boolean
    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

然后在您的宏中使用該函數

If URLExists(DirFile) = 0 Then
    Set wbA = Workbooks.Open("http://www.clevelandfed.org/research/data/inflation_expectations/" & Format(Now, "YYYY") & "/" & Format(DateAdd("m", -1, Date), "MMMM") & "/excel1.xls", IgnoreReadOnlyRecommended:=True)
    wbA.Activate
'If the current month file exists, open it
Else
    Set wbA = Workbooks.Open(DirFile, IgnoreReadOnlyRecommended:=True)
End If

Answer 2

這是另一種選擇。 只需嘗試打開它，看看它是否失敗。 如果可以，請在上個月打開。 沒有更好，只是有所不同。

Public Function GetCFWorkbook() As Workbook

    Dim wb As Workbook
    Dim dt As Date

    dt = Now

    Const sURL As String = "http://www.clevelandfed.org/research/data/inflation_expectations/"

    On Error Resume Next
    Application.DisplayAlerts = False
        Set wb = Workbooks.Open(sURL & Format(dt, "yyyy/mmmm") & "/excel1.xls")
    Application.DisplayAlerts = True
    On Error GoTo 0

    If wb Is Nothing Then
        Set wb = Workbooks.Open(sURL & Format(DateAdd("m", -1, dt), "yyyy/mmmm") & "/excel1.xls")
    End If

    Set GetCFWorkbook = wb

End Function