Как импортировать датированный файл XLS из веб-VBA - PullRequest
Новая
       46

Как импортировать датированный файл XLS из веб-VBA

0 голосов
/ 19 марта 2019

Мне нужно импортировать файл xls с веб-адреса https://docs.misoenergy.org/marketreports/YYYYMMDD_sr_nd_is.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

1 Ответ

0 голосов
/ 22 марта 2019

Независимо от использования QueryTable, вы можете открывать онлайн-файлы прямо из Excel. Ниже приведен пример того, как сгенерировать URL-адрес на основе ввода даты и открыть его из Excel. 

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
...