导航IE

时间:2019-07-25 11:36:01

标签: excel vba

我刚刚使用EI(获取原始数据并将其复制粘贴到文件中)自动完成了报告。但是我想我在浏览IE后缺少一些代码原因,它只是打开文件而不是复制粘贴它。在调试模式下,我的复制粘贴代码有效,但除此之外没有任何作用。

复制粘贴代码在调试模式下有效,但在运行宏时无效

Sub Get_RawFile()
'
'
'
    Dim IE As New InternetExplorer
    Dim HTMLDoc As HTMLDocument
    Dim HTMLselect As HTMLSelectElement
    Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
    Dim rngToCopy  As Range

    With IE
        .Visible = True
        .Navigate ("---------------------------") 'Navigates website to get data

    While IE.Busy Or IE.readyState <> 4: DoEvents: Wend

    Set HTMLDoc = IE.document
    HTMLDoc.all.UserName.Value = Sheets("Data Dump").Range("A1").Value
    HTMLDoc.all.Password.Value = Sheets("Data Dump").Range("B1").Value
    HTMLDoc.getElementById("login-btn").Click

    While IE.Busy Or IE.readyState <> 4: DoEvents: Wend
    Application.Wait (Now + TimeValue("0:00:05"))

    Set objButton = HTMLDoc.getElementById("s2id_ddlReportType")
    Set HTMLselect = HTMLDoc.getElementById("ddlReportType")
    objButton.Focus
    HTMLselect.Value = "2"

    Set HTMLselectZone = HTMLDoc.getElementById("ddlTimezone")
    HTMLselectZone.Value = "PST8PDT"

    Set subgroups = HTMLDoc.getElementById("s2id_ddlSubgroups")
    subgroups.Click
    Set subgroups2 = HTMLDoc.getElementById("ddlSubgroups")
    subgroups2.Value = "1456_17"

    HTMLDoc.getElementById("dtStartDate").Value = Format(Sheets("Attendance").Range("B6").Value, "yyyy-mm-dd")
    HTMLDoc.getElementById("dtEndDate").Value = Format(Sheets("Attendance").Range("X6").Value, "yyyy-mm-dd")

    HTMLDoc.getElementById("btnGetReport").Focus
    HTMLDoc.getElementById("btnGetReport").Click
    Application.Wait (Now + TimeValue("0:00:05"))

    HTMLDoc.getElementById("btnDowloadReport").Click
    Application.Wait (Now + TimeValue("0:00:05"))
    Application.SendKeys "{LEFT}"
    Application.SendKeys "{ENTER}"
    Application.Wait (Now + TimeValue("0:00:02"))
    Application.SendKeys "{ENTER}"
    Application.Wait (Now + TimeValue("0:00:02"))
    Application.SendKeys "{DOWN}"
    Application.Wait (Now + TimeValue("0:00:02"))
    Application.SendKeys "{ENTER}" 'Opens downloaded file

    IE.Quit

    'Copy Paste Code
    Set Wb1 = ThisWorkbook

    For Each wB In Application.Workbooks
    If Left(wB.Name, 14) = "attenRealTime" Then
       Set wb2 = wB
       Exit For
    End If
    Next

    If Not wb2 Is Nothing Then

    With wb2.Sheets(1)
        Set rngToCopy = .Range("A1:U50", .Cells(.Rows.Count, "A").End(xlUp))
        rngToCopy.Copy
    End With

    For Each wb2 In Application.Workbooks
        wb2.Activate
    Next

    Wb1.Sheets("Data Dump").Range("A6").PasteSpecial Paste:=xlPasteValues

    End If
    End With

0 个答案:

没有答案