Question

我需要从网址https://docs.misoenergy.org/marketreports/YYYYMMDD_sr_nd_is.xls导入xls文件，其中用户在同一工作簿的另一个工作表上输入了YYYYMMDD。在nsiday = 20190316-1下面的代码中。我不知道如何将数据实际粘贴到所需的工作表中。我正在尝试改编可捕获csv文件的代码，以使其适用于xls文件（https://docs.misoenergy.org/marketreports/YYYYMMDD_rt_lmp_final.csv）。我希望这是有道理的，并感谢大家的阅读/帮助！注意：我没有包括我要适应的完整csv代码。

Option Explicit

Sub NSI()
    Dim xday As String
    Dim todaystamp As String
    Dim nsiday As String
    Dim MISORTSht As Worksheet
    Dim Selection As Range

    Set MISORTSht = Sheet3

    MISORTSht.Cells.ClearContents
    If MISORTSht.QueryTables.Count > 0 Then
    MISORTSht.QueryTables(1).Delete
    End If


    Dim web As Object
    Set web = CreateObject("Microsoft.XMLHTTP")

    todaystamp = Format(Sheet1.Cells(6, 1).Value, "yyyymmdd")
    xday = Format(Sheet1.Cells(1, 1).Value, "yyyymmdd")
    'xday is user defined
    nsiday = xday - 1


start:
    web.Open "GET", "https://docs.misoenergy.org/marketreports/" & nsiday & "_sr_nd_is" & ".xls", False
    web.send

    If web.Status = "200" Then

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With MISORTSht.QueryTables.Add(Connection:="URL;https://docs.misoenergy.org/marketreports/" & nsiday & "_sr_nd_is" & ".xls" _
    , Destination:=MISORTSht.Range("A1"))
    .Name = "NSI_MISO"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = False
    .RefreshOnFileOpen = False
    .BackgroundQuery = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = False
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

Answer 1

不管使用QueryTable，都可以直接从Excel打开联机文件。以下是如何根据日期输入生成URL并从Excel中打开URL的示例。

Option Explicit

Private Const DATE_FMT As String = "yyyymmdd"
Private Const BASE_URL As String = "https://docs.misoenergy.org/marketreports/"
Private Const POSTFIX1 As String = "_sr_nd_is.xls"
Private Const POSTFIX2 As String = "_rt_lmp_final.csv"

Sub Main()
    Dim dDataDate As Date, dToday As Date, oWB As Workbook

    dToday = CDate(ThisWorkbook.Sheets(1).Cells(6, 1).Value) ' Not sure what to do with this
    dDataDate = CDate(ThisWorkbook.Sheets(1).Cells(1, 1).Value) - 1 ' 1 day before it

    Set oWB = GetOnlineFile(CreateURL1(dDataDate))

    If Not oWB Is Nothing Then
        ' Do whatever you need with the opened file

        oWB.Close
        Set oWB = Nothing
    End If
End Sub

Private Function GetOnlineFile(URL As String) As Workbook
    On Error Resume Next
    Set GetOnlineFile = Workbooks.Open(URL)
End Function

Private Function CreateURL1(DataDate As Date) As String
    CreateURL1 = BASE_URL & Format(DataDate, DATE_FMT) & POSTFIX1
End Function

Private Function CreateURL2(DataDate As Date) As String
    CreateURL2 = BASE_URL & Format(DataDate, DATE_FMT) & POSTFIX2
End Function

如何从Web VBA导入已过时的xls文件

1 个答案: