Question

我刚刚完成了报表的自动化（打开即浏览，即提取数据，然后打开下载的数据）。我现在正在复制粘贴提取的文件到当前工作簿。问题是

下载的工作簿的名称末尾有不同的编号
每个
第一个下载的标签页或工作表未命名为“第1页”

最后一个sendKey命令之后，下载的文件将打开。

每个文件都有一个名称标识符，即“ RealTime”，用于文件名和选项卡。

注释的脚本不起作用

Sub Get_RawFile()
'
'
'
    Dim IE As New InternetExplorer
    Dim HTMLDoc As HTMLDocument
    Dim HTMLselect As HTMLSelectElement

    With IE
        .Visible = True
        .Navigate ("-------------------------")

    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:10"))

    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}"

    Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
    Dim rngToCopy As Range

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

    'If Not Wb1 Is Nothing Then
    '    Set wb2 = ThisWorkbook

    '   With Wb1.Sheets(1)
    '        Set rngToCopy = .Range("A:U", .Cells(.Rows.Count, "A").End(xlUp))
    '    End With
    '   wb2.Sheets(2).Range("A5").Resize(rngToCopy.Rows.Count).Value = rngToCopy.Value
    'End If

End Sub

Answer 1

问题：

您每次都在使用本工作簿。应该是不同的书。找到一个，将您要复制数据的另一个工作簿。

在SendKeys之后更改零件：

Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
Dim rngToCopy As Range

Set Wb1 = ThisWorkbook

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

If Not wb2 Is Nothing Then

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

    Wb1.Sheets(2).Range("A5").Resize(rngToCopy.Rows.Count).Value = rngToCopy.Value

End If

将粘贴的打开的图纸文件复制到当前工作簿

1 个答案: