將粘貼的打開的圖紙文件復制到當前工作簿

Question

我剛剛完成了報表的自動化（打開即瀏覽，即提取數據，然后打開下載的數據）。 我現在正在復制粘貼提取的文件到當前工作簿。 問題是

• 下載的工作簿名稱末尾有不同的數字
  每一個
• 下載第一個選項卡或工作表未命名為“工作表1

在執行最后一個sendKey命令后​​，將打開下載的文件。

每個文件都有一個名稱標識符，即文件名和制表符的“實時”。

帶注釋的腳本不起作用

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