excel VBA连接

时间:2018-12-14 17:32:09

标签: excel vba excel-vba

我正在尝试使用上一个宏并进行一些调整以连接到其他网页。这些网页有些相似。希望有人可以帮助我

这是用于正常工作的另一个文件中的先前连接的代码。

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

结束子

0 个答案:

没有答案