我需要从网址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
无论使用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