VBA从Internet实时获取错误:指定资源的下载失败

时间:2019-06-13 11:14:08

标签: vba api

我想从Internet实时获取Excel文件,在我的计算机上它不起作用,但在另一台计算机上它可以起作用。

我的计算机上的错误是:

  

“指定资源的下载失败。”

Function GetUCTTimeDate() As Date
Dim UTCDateTime As String
Dim arrDT() As String
Dim http As Object
Dim UTCDate As String
Dim UTCTime As String

Const NetTime As String = "https://www.time.gov/"

On Error Resume Next
Set http = CreateObject("Microsoft.XMLHTTP")
On Error GoTo 0

http.Open "GET", NetTime & Now(), False, "", ""
http.send

UTCDateTime = http.getResponseHeader("Date")
UTCDate = Mid(UTCDateTime, InStr(UTCDateTime, ",") + 2)
UTCDate = Left(UTCDate, InStrRev(UTCDate, " ") - 1)
UTCTime = Mid(UTCDate, InStrRev(UTCDate, " ") + 1)
UTCDate = Left(UTCDate, InStrRev(UTCDate, " ") - 1)
GetUCTTimeDate = DateValue(UTCDate) + TimeValue(UTCTime)
End Function

2 个答案:

答案 0 :(得分:0)

以前我也遇到过完全相同的问题..在我的电脑上工作正常,但在另一台电脑上出错。

要解决此问题,请将函数“按字符串”而不是“按日期”变暗

Public Function GetUCTTimeDate() As String  

并从GetUCTTimeDate = DateValue(UTCDate)删除“ DateValue”

答案 1 :(得分:0)

我遇到了同样的问题。它发生在我将计算机的格式日期从 mm/dd/yyyy 更改为 dd/mm/yyyy 时。我试图解决它,我找到的解决方案是将日期传递给工作表,然后再取一次。

Function GetUCTTimeDate() As Date
    Dim UTCDateTime As String
    Dim arrDT() As String
    Dim http As Object
    Dim UTCDate As String
    Dim UTCTime As String

    Const NetTime As String = "https://www.time.gov/"

    On Error Resume Next
    Set http = CreateObject("Microsoft.XMLHTTP")
    On Error GoTo 0

    http.Open "GET", NetTime & Now(), False, "", ""
    http.send

    UTCDateTime = http.getResponseHeader("Date")
    UTCDate = Mid(UTCDateTime, InStr(UTCDateTime, ",") + 2)
    UTCDate = Left(UTCDate, InStrRev(UTCDate, " ") - 1)
    Worksheets("Hoja1").Range("C2") = UTCDate   'Here I passed to the sheet
    UTCTime = Mid(UTCDate, InStrRev(UTCDate, " ") + 1)
    UTCDate = Left(UTCDate, InStrRev(UTCDate, " ") - 1)
    GetUCTTimeDate = Worksheets("Hoja1").Range("C2") 'Getting again the date

End Function