Excel实例之间的参考工作簿
很长时间的用户，第一个问题。
所以我的企业用来获取煤船运动信息的一个网站最近被重新修改了，所以我不得不重新修改我的程序来删除船舶信息。 我一直使用button点击事件和使用导航到每个端口; Dim Table As Object, Set Table = ie.document.getElementsByTagName("TABLE")(11)来获取实际的表格。 在新的网站上，他们可以select导出所有的船舶动作，如果我可以自动化macros来获得excel文件，速度会更快。 澄清我只是想让我的程序去这个网站; https://qships.tmr.qld.gov.au/webx/ ，点击上面的“Ship Movements”，点击“Tools”，点击“Export to 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
为了将工作表中的工作表返回到我的主工作簿，我将在那里search并获取我想要的工作表。 这是我所得到的结果。
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（） VBA可以跨越Excel的实例吗？ 而且我不知道如何使用句柄引用excel工作簿。 我认为他们打开了一个新的Excel实例，因为macros正在运行，甚至在使用Sleep（）时也不会让Excel打开新的工作簿。 我曾尝试使用Do DoWhile循环让Excel打开工作簿，但似乎并不奏效。 所以，如果任何人都可以帮助我在同一个Excel实例中打开工作簿，以便我可以更容易地引用它们，或者在不使用GetObject（）的情况下引用它们，这将不胜感激。
==================================编辑=============== ========================
这是我结束的最后结果。 感谢user3565396我只是把它保存在你build议的下载文件夹中，我无法弄清楚如何使用WinHttp像Robert Co推荐的那样。 出于某种原因，代码退出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
这是解决scheme。 我跳过了一些你已经正确完成的步骤。 代码从单击工具开始，然后导出到Excel。 之后，我点击保存（未打开）的“Alt + S”。 有了这段代码，我设法将工作表从下载的文件复制到我运行VBA代码的工作簿中。 希望有所帮助。
PS所有文件必须在同一个目录下。
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
当您单击某个链接时，会将其下载到浏览器的临时文件夹中，并在另一个会话中使用推荐的应用程序将其打开。 诀窍是在VBA本身下载文件，并在同一个会话中打开它。 如果url是可预测的，你当然可以自动化。
使用WinHttp作为stream下载并在您自己的临时文件夹中重新创build该文件。 大概有10行代码 继续使用Workbooks.Open在同一会话中打开文件的VBA。