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

Question

我刚刚完成了报告的自动化（打开 ie、导航 ie、提取数据和打开下载的数据）。我现在正在将提取的文件复制粘贴到当前工作簿。问题是

• 下载的工作簿名称末尾有不同的数字
  每一个
• 下载的第一个选项卡或工作表未命名为“工作表 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