vba - Excel 实例之间的引用工作簿

Question

长期用户，第一个问题。

因此，我的业务用于获取有关煤船运动信息的网站最近被重新设计，因此我必须重新设计我的程序以抓取船舶信息。我一直在使用按钮单击事件导航到每个端口并使用；Dim Table As Object, Set Table = ie.document.getElementsByTagName("TABLE")(11)得到实际的表。在新站点上，他们可以选择将所有船舶运动导出到 excel 中，如果我可以自动化宏来获取 excel 文件，那会快很多。为了澄清我只是想让我的程序进入这个站点； https://qships.tmr.qld.gov.au/webx/ ，单击顶部的“船舶运动”，单击“工具”，单击“导出到 excel”，然后打开文件并返回该站点并单击“出生时的船舶”、“工具”、“导出到 excel”和打开该文件，然后使用类似的东西；
Windows("Traffic.xls").Activate
Application.ActiveProtectedViewWindow.Edit
Sheets("Traffic").Select
Application.DisplayAlerts = False
Sheets("Traffic").Move After:=Workbooks("Search Ship Schedule.xlsm").Sheets(4)
Application.DisplayAlerts = True
要将工作簿中的工作表返回到我的主工作簿，然后我将在其中搜索并获取我想要的工作表。这是我到目前为止所得到的；

Dim ws1, ws2 As Worksheet
Set ws1 = ActiveSheet
Set ws2 = ThisWorkbook.Sheets("Sheet1")
ws2.Cells.ClearContents


Dim Site, BtnPage(1 To 2), Btn As String
Site = "https://qships.tmr.qld.gov.au/webx/"
Dim ie As InternetExplorer

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate Site

        Do While Not ie.readyState = 4 Or ie.Busy
            DoEvents
        Loop
        Application.Wait (Now() + TimeValue("0:00:3"))

ie.document.getElementById("Traffic").Click


        Do While Not ie.readyState = 4 Or ie.Busy
            DoEvents
        Loop
        Application.Wait (Now() + TimeValue("0:00:3"))

ie.document.getElementsByClassName("ui-widget fg-button fg-button-icon-left ui-corner-all grid-tools")(0).Click
Sleep 100
ie.document.getElementById("0").Click

        Do While Not ie.readyState = 4 Or ie.Busy
            DoEvents
        Loop

Sleep 2500

SendKeys "%o"

        Do While Not ie.readyState = 4 Or ie.Busy
            DoEvents
        Loop
Sleep 6500

'Sleep_DoEvents 7

ie.document.getElementById("InPort").Click


Do While Not ie.readyState = 4 Or ie.Busy
            DoEvents
        Loop
        Application.Wait (Now() + TimeValue("0:00:3"))

ie.document.getElementsByClassName("ui-widget fg-button fg-button-icon-left ui-corner-all grid-tools")(0).Click
Sleep 100
ie.document.getElementById("0").Click

        Do While Not ie.readyState = 4 Or ie.Busy
            DoEvents
        Loop

        'Windows("Traffic").Activate
        'Application.Windows("Traffic.xls").ActiveProtectedViewWindow.Edit
        'Application.Windows("Traffic.xls").Activate

        Static hWnds() As Variant
        Sleep 500
        r = FindWindowLike(hWnds(), 0, "Public Pages - Internet Explorer", "*", Null)

        Sleep 3000

        If r > 0 Then
            SetFocusAPI (hWnds(1))
            'Sleep 1000
            SendKeys "%o"
            Do While Not ie.readyState = 4 Or ie.Busy
                DoEvents
            Loop
            Sleep 6000
            'Application.ActiveProtectedViewWindow.Edit
        End If
'ie.Close

我在一个模块中有这个

Public Declare Function BlockInput Lib "USER32.dll" (ByVal fBlockIt As Long) As Long


#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

 Declare Function SetFocusAPI Lib "User32" Alias "SetForegroundWindow" _
    (ByVal hWnd As Long) As Long
   Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, _
    ByVal wCmd As Long) As Long
   Declare Function GetDesktopWindow Lib "User32" () As Long
   Declare Function GetWindowLW Lib "User32" Alias "GetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   Declare Function GetParent Lib "User32" (ByVal hWnd As Long) As Long
   Declare Function GetClassName Lib "User32" Alias "GetClassNameA" _
    (ByVal hWnd As Long, ByVal lpClassName As String, _
     ByVal nMaxCount As Long) As Long
   Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" _
    (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) _
     As Long

   Public Const GWL_ID = (-12)
   Public Const GW_HWNDNEXT = 2
   Public Const GW_CHILD = 5
   'FindWindowLike
   ' - Finds the window handles of the windows matching the specified
   '   parameters
   '
   'hwndArray()
   ' - An integer array used to return the window handles
   '
   'hWndStart
   ' - The handle of the window to search under.
   ' - The routine searches through all of this window's children and their
   '   children recursively.
   ' - If hWndStart = 0 then the routine searches through all windows.
   '
   'WindowText
   ' - The pattern used with the Like operator to compare window's text.
   '
   'ClassName
   ' - The pattern used with the Like operator to compare window's class
   '   name.
   '
   'ID
   ' - A child ID number used to identify a window.
   ' - Can be a decimal number or a hex string.
   ' - Prefix hex strings with "&H" or an error will occur.
   ' - To ignore the ID pass the Visual Basic Null function.
   '
   'Returns
   ' - The number of windows that matched the parameters.
   ' - Also returns the window handles in hWndArray()
   '
   '----------------------------------------------------------------------
   'Remove this next line to use the strong-typed declarations
   #Const WinVar = True
   #If WinVar Then
   Function FindWindowLike(hWndArray() As Variant, _
    ByVal hWndStart As Variant, WindowText As String, _
     Classname As String, ID) As Integer
   Dim hWnd
   Dim r
   Static level
   Static iFound
   #ElseIf Win32 Then
   Function FindWindowLike(hWndArray() As Long, ByVal hWndStart As Long, _
    WindowText As String, Classname As String, ID) As Long
   Dim hWnd As Long
   Dim r As Long
   ' Hold the level of recursion:
   Static level As Long
   ' Hold the number of matching windows:
   Static iFound As Long
   #ElseIf Win16 Then
   Function FindWindowLike(hWndArray() As Integer, _
    ByVal hWndStart As Integer, WindowText As String, _
    Classname As String, ID) As Integer
   Dim hWnd As Integer
   Dim r As Integer
   ' Hold the level of recursion:
   Static level As Integer
   'Hold the number of matching windows:
   Static iFound As Integer
   #End If
   Dim sWindowText As String
   Dim sClassname As String
   Dim sID
   ' Initialize if necessary:
   If level = 0 Then
   iFound = 0
   ReDim hWndArray(0 To 0)
   If hWndStart = 0 Then hWndStart = GetDesktopWindow()
   End If
   ' Increase recursion counter:
   level = level + 1
   ' Get first child window:
   hWnd = GetWindow(hWndStart, GW_CHILD)
   Do Until hWnd = 0
   DoEvents ' Not necessary
   ' Search children by recursion:
   r = FindWindowLike(hWndArray(), hWnd, WindowText, Classname, ID)
   ' Get the window text and class name:
   sWindowText = Space(255)
   r = GetWindowText(hWnd, sWindowText, 255)
   sWindowText = Left(sWindowText, r)
   sClassname = Space(255)
   r = GetClassName(hWnd, sClassname, 255)
   sClassname = Left(sClassname, r)
   ' If window is a child get the ID:
   If GetParent(hWnd) <> 0 Then
   r = GetWindowLW(hWnd, GWL_ID)
   sID = CLng("&H" & Hex(r))
   Else
   sID = Null
   End If
   ' Check that window matches the search parameters:
   If sWindowText Like WindowText And sClassname Like Classname Then
   If IsNull(ID) Then
   ' If find a match, increment counter and
   '  add handle to array:
   iFound = iFound + 1
   ReDim Preserve hWndArray(0 To iFound)
   hWndArray(iFound) = hWnd
   ElseIf Not IsNull(sID) Then
   If CLng(sID) = CLng(ID) Then
   ' If find a match increment counter and
   '  add handle to array:
   iFound = iFound + 1
   ReDim Preserve hWndArray(0 To iFound)
   hWndArray(iFound) = hWnd
   End If
   End If
   Debug.Print "Window Found: "
   Debug.Print "  Window Text  : " & sWindowText
   Debug.Print "  Window Class : " & sClassname
   Debug.Print "  Window Handle: " & CStr(hWnd)
   End If
   ' Get next child window:
   hWnd = GetWindow(hWnd, GW_HWNDNEXT)
   Loop
   ' Decrement recursion counter:
   level = level - 1
   ' Return the number of windows found:
   FindWindowLike = iFound
   End Function

我的问题是，当这些 excel 文件打开时，它们会在新的 excel 实例中打开，我无法以任何常规方式引用它们。由于它们实际上并未保存，因此我无法像此答案中推荐的那样使用 GetObject() Can VBA Reach Across Instances of Excel?而且我不知道如何使用句柄引用 excel 工作簿。我认为他们正在一个新的 excel 实例中打开，因为宏正在运行，即使使用 Sleep() 它也不会让 excel 打开新的工作簿。我曾尝试使用 DoDoWhile 循环让 excel 打开工作簿，但这似乎不起作用。因此，如果有人可以帮助我在同一个 excel 实例中打开工作簿，以便我可以更轻松地引用它们，或者在没有 GetObject() 的情况下在 excel 实例之间进行引用，那将不胜感激。

===================================编辑=============== =========================

这是我最终得到的结果。感谢 user3565396 我只是按照你的建议将它保存在下载文件夹中，我不知道如何使用 WinHttp像罗伯特公司推荐的。出于某种原因，代码在 wb2.Sheets(1).Copy After:=wb1.Sheets("Import") 行上没有出现错误消息而退出。但重新打开似乎效果很好，而且每天只使用一到两次。

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Integer

Function DelTrafficAndInPort()

'Clear all ws's like "Traffic" or "In Port" and all wb's

    'In VBE, click Tools, References, find "Microsoft Scripting Runtime"
    'and check it off for this program to work
    Dim fso As FileSystemObject
    Dim fold As Folder
    Dim f As File
    Dim folderPath As String
    Dim cbo As Object

    folderPath = "C:\Users\" & Environ("username") & "\Downloads"

    Set fso = New FileSystemObject
    Set fold = fso.GetFolder(folderPath)

    For Each f In fold.Files
        If ((Left(f.Name, 7) = "Traffic" Or Left(f.Name, 7) = "In Port") And Right(f.Name, 4) = ".xls") Then
            fso.DeleteFile f.Path
        End If
    Next
End Function



Sub BtnScrape_Click()

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False


Dim wb1, wb2 As Workbook
    Set wb1 = ActiveWorkbook

    Run DelTrafficAndInPort() ' from downloads

    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In wb1.Worksheets
        If (Left(ws.Name, 7) = "Traffic" Or Left(ws.Name, 7) = "In Port") Then ws.Delete
    Next ws
    Application.DisplayAlerts = True

Dim ie As InternetExplorer 'SHDocVw.InternetExplorer
Dim sw As New SHDocVw.ShellWindows

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "https://qships.tmr.qld.gov.au/webx/"

Do While Not ie.readyState = 4 Or ie.Busy
DoEvents
Loop

Dim BtnName(1 To 2), wbPath(1 To 2) As String
    BtnName(1) = "Traffic"
    BtnName(2) = "InPort"
    wbPath(1) = "C:\Users\" & Environ("username") & "\Downloads\Traffic.xls" '"C:\Users\owner\Downloads\Traffic.xls"
    wbPath(2) = "C:\Users\" & Environ("username") & "\Downloads\In Port.xls"

Dim I As Integer
For I = 1 To 2
    ie.document.getElementById(BtnName(I)).Click

    Do While Not ie.readyState = 4 Or ie.Busy
    DoEvents
    Loop

    Application.Wait (Now() + TimeValue("00:00:04"))

    ie.document.getElementsByTagName("span")(8).Click 'Tools
    Application.Wait (Now() + TimeValue("00:00:01"))
    ie.document.getElementById("0").Click             'Export to Excel    'ie.document.getElementsByTagName("span")(27).Click
    Application.Wait (Now() + TimeValue("00:00:5"))

    SetForegroundWindow (ie.hwnd)
    Application.Wait (Now() + TimeValue("00:00:01"))
    SendKeys "%S" 'Save
    Application.Wait (Now() + TimeValue("00:00:02"))
    Set wb2 = Workbooks.Open(wbPath(I))
    wb2.Sheets(1).Copy After:=wb1.Sheets("Import")
    wb2.Close False
Next I
ie.Quit

wb1.Sheets("Import").Select

Run DelTrafficAndInPort() ' from downloads

    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

MsgBox "Finished"
End Sub

Answer 1

这是解决方案。我跳过了您正确完成的一些步骤。代码从单击工具开始，然后单击导出到 excel。之后，我单击“Alt + S”，即保存(未打开)。使用此代码，我设法将工作表从下载的文件复制到运行 VBA 代码的工作簿中。希望有帮助。

附言所有文件必须位于同一目录中。

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Integer

Dim ie As SHDocVw.InternetExplorer
Dim sw As New SHDocVw.ShellWindows
Sub test()
Dim hw As Long, rtrn As Integer
For Each ie In sw
    If ie.LocationURL = "https://qships.tmr.qld.gov.au/webx/" Then
        ie.Document.getElementsByTagName("span")(8).Click 'Tools
        ie.Document.getElementsByTagName("span")(27).Click 'Export to Excel
        Application.Wait (Now() + TimeValue("00:00:10"))
        Exit For
    End If
Next ie
hw = ie.hwnd
rtrn = SetForegroundWindow(hw)
Application.Wait (Now() + TimeValue("00:00:03"))
SendKeys "%S" 'Save
Application.Wait (Now() + TimeValue("00:00:03"))
Workbooks.Open ("Traffic.xls")
Dim sh As Worksheet, wb As Workbook
Set wb = Workbooks("TEST.xlsb") 'Target Workbook
For Each sh In Workbooks("Traffic.xls").Worksheets
    sh.Copy After:=wb.Sheets(wb.Sheets.Count)
Next sh
End Sub