Excel實例之間的參考工作簿

Question

長時間用戶，第一個問題。

因此，一個我的企業用來獲取煤船運動信息的網站最近被重新設計了，所以我不得不重新編寫我的程序來抓取船舶信息。我一直在使用按鈕點擊事件導航到每個端口並使用; Dim Table As Object, Set Table = ie.document.getElementsByTagName("TABLE")(11) 得到實際的表格。在新的站點上，他們可以選擇將所有船隻的運動導出爲ex​​cel，如果我可以自動化宏來獲取excel文件，它將更快。澄清我只是想讓我的程序去這個網站;點擊'Ship Movements'點擊'Tools'，點擊'Export to excel'，然後打開文件並返回到站點並點擊'Vessel At birth'，'Tools'，'Export to 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打開新的工作簿。我曾嘗試使用Do DoWhile Loop讓excel打開工作簿，但似乎不起作用。所以，如果任何人都可以幫助我在相同的Excel實例中打開工作簿，以便我可以更容易地引用它們，或者在不使用GetObject（）的情況下引用它們，這將不勝感激。

==================================編輯=========== ============================

這是我最終解決的結果。感謝user3565396我只是把它保存在你推薦的下載文件夾中，我無法弄清楚如何使用像Robert Co推薦的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代碼的工作簿。希望有所幫助。

P.S.所有文件必須位於同一個目錄中。

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 

Answer 2

當您單擊一個鏈接時，它會將其下載到瀏覽器臨時文件夾，並在另一個會話中使用推薦的應用程序將其打開。訣竅是在VBA本身內下載文件並在同一會話中打開它。如果url是可預測的，那麼你肯定可以自動化。

使用WinHttp作爲流下載並在您自己的臨時文件夾中重新創建該文件。它大約有10行代碼。繼續使用Workbooks.Open在同一會話中打開文件的VBA。