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 Function 返回一个String，表示与指定的模式或文件属性或驱动器的卷标签匹配的文件，目录或文件夹的名称。

你需要的是following function to check if the URL is valid， 的 P.S。将功能放在模块

中

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