长时间用户，第一个问题。
因此，我的企业用来获取煤炭运输信息的互联网网站最近已被重新设计，因此我必须重新修改我的计划以刮取船舶信息。我一直使用按钮点击事件导航到每个端口并使用;
Dim Table As Object, Set Table = ie.document.getElementsByTagName("TABLE")(11)
得到实际的表。在新网站上，他们可以选择将所有船舶移动导出到excel，如果我可以自动化宏来获取excel文件，它会更快。澄清我只是想让我的程序去这个网站; https://qships.tmr.qld.gov.au/webx/，点击＆＃39;发货转移＆＃39;在顶部，点击工具＆＃39;，点击＆＃39;导出到excel＆＃39;然后打开文件并返回该站点，然后点击“出生时的船只”，“工具”，“出口到卓越”。并打开该文件，然后使用类似的东西;
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的新实例中打开，我无法以常规方式引用它们。由于它们实际上没有保存，我不能像在这个答案Can VBA Reach Across Instances of Excel?中推荐的那样使用GetObject（），并且我不知道如何使用句柄引用excel工作簿。我认为他们正在开启一个新的excel实例，因为宏正在运行，即使使用Sleep（），它也不会让excel打开新的工作簿。我尝试过使用Do DoWhile循环让excel打开工作簿，但这似乎不起作用。所以，如果有人可以帮我在同一个excel实例中打开工作簿，这样我就可以更容易地引用它们，或者在没有GetObject（）的excel实例之间引用，这将非常感激。
================================== EDIT ============ ===========================
这是我结束的最终结果。感谢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
答案 0 :(得分：0)
这是解决方案。我跳过了你正确完成的一些步骤。代码从单击工具开始，然后单击导出到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
答案 1 :(得分：-1)
单击某个链接时，会将其下载到浏览器临时文件夹，然后在另一个会话中使用推荐的应用程序将其打开。诀窍是在VBA中下载文件并在同一会话中打开它。如果网址是可预测的，那么你当然可以实现自动化。
使用WinHttp作为流下载并在您自己的临时文件夹中重新创建该文件。它大约有10行代码。使用Workbooks.Open继续VBA，在同一会话中打开文件。