我正在尝试使用上一个宏并进行一些调整以连接到其他网页。这些网页有些相似。希望有人可以帮助我
这是用于正常工作的另一个文件中的先前连接的代码。
Sub Hour2PPR()
'
' DataPull Macro
'
Application.ScreenUpdating = False
Dim SD As Date
Dim ED As Date
Dim STS As Integer
Dim ETS As Integer
Dim STE As Integer
Dim ETE As Integer
SD = Worksheets("Variables").Range("A2").Value
ED = Worksheets("Variables").Range("A2").Value
STS = Worksheets("Variables").Range("B3").Value
ETS = Worksheets("Variables").Range("C3").Value
STE = Worksheets("Variables").Range("D2").Value
ETE = Worksheets("Variables").Range("D2").Value
Application.ScreenUpdating = False
'On Error GoTo Errorcatch
If Worksheets("0800").Visible = xlSheetHidden Then
Worksheets("0800").Visible = xlSheetVisible
End If
Sheets("0800").Activate
Sheets("0800").Select
Cells.Select
Selection.ClearContents
Sheets("0800").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://"Redacted"/reports/processPathRollup?reportFormat=HTML&warehouseId="Redacted"&maxIntradayDays=1&spanType=Intraday&startDateIntraday=" & Year(SD) & "%2F" & Month(SD) & "%2F" & Day(SD) & "&startHourIntraday=" & (STS) & "&startMinuteIntraday=" & (STE) & "&endDateIntraday=" & Year(ED) & "%2F" & Month(ED) & "%2F" & Day(ED) & "&endHourIntraday=" & (ETS) & "&endMinuteIntraday=" & (ETE) & "&adjustPlanHours=true&_adjustPlanHours=on&_hideEmptyLineItems=on&employmentType=AllEmployees", _
Destination:=Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
Worksheets("0800").Range("E135:G150").Copy
Worksheets("PPRData").Range("K4").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Recap").Select
End With
If Worksheets("0800").Visible = xlSheetVisible Then
Worksheets("0800").Visible = xlSheetHidden
End If
End Sub
这是我要使用的新网页
https://"Redacted"/ppa/inspect/process?primaryAttribute=PICKING_PROCESS_PATH&secondaryAttribute=PICKING_PROCESS_PATH&nodeType=FC&warehouseId="Redacted"&processId=100055&maxIntradayDays=1&spanType=Intraday&startDateIntraday=2018%2F12%2F13&startHourIntraday=15&startMinuteIntraday=30&endDateIntraday=2018%2F12%2F13&endHourIntraday=16&endMinuteIntraday=
这是我尝试进行的与原始代码匹配的代码/网址更正。但是,当我尝试运行此命令时,出现编译错误:预期:列表分隔符或)带有“,在URL的末尾突出显示
Sub Hour1PPR()
'
' DataPull Macro
'
Application.ScreenUpdating = False
Dim SD As Date
Dim ED As Date
Dim STS As Integer
Dim ETS As Integer
Dim STE As Integer
Dim ETE As Integer
SD = Worksheets("Variables").Range("A2").Value
ED = Worksheets("Variables").Range("A2").Value
STS = Worksheets("Variables").Range("B3").Value
ETS = Worksheets("Variables").Range("C3").Value
STE = Worksheets("Variables").Range("D2").Value
ETE = Worksheets("Variables").Range("D2").Value
Application.ScreenUpdating = False
'On Error GoTo Errorcatch
If Worksheets("0700").Visible = xlSheetHidden Then
Worksheets("0700").Visible = xlSheetVisible
End If
Sheets("0700").Activate
Sheets("0700").Select
Cells.Select
Selection.ClearContents
Sheets("0700").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://"Redacted".com/ppa/inspect/process?primaryAttribute=PICKING_PROCESS_PATH&secondaryAttribute=PICKING_PROCESS_PATH&nodeType=FC&warehouseId="Redacted"&processId=100114&maxIntradayDays=1&spanType=Intraday&startDateIntraday=" & Year(SD) & "%2F" & Month(SD) & "%2F" & Day(SD) & "&startHourIntraday=" & (STS) & "&startMinuteIntraday=" & (STE) & "&endDateIntraday=" & Year(ED) & "%2F" & Month(ED) & "%2F" & Day(ED) & "&endHourIntraday=" & (ETS) & "&endMinuteIntraday=" & (ETE)", _
Destination:=Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
Worksheets("0700").Range("E135:G150").Copy
Worksheets("PPAData").Range("H4").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Rates").Select
End With
If Worksheets("0700").Visible = xlSheetVisible Then
Worksheets("0700").Visible = xlSheetHidden
End If
结束子