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