无法设置 Internet Explorer 11 以获得焦点
Can't set internet explorer 11 to get the focus
我在使用 MS ACCESS 宏在 IE11 中保存下载的文件时遇到问题。
这是我下载后想点击的地方link :
我需要使用用户名/密码登录才能进入该页面。
我目前正在使用 SendKeys 获取文件，当我手动执行我的宏时，它工作得很好。但是，当我使用 Windows 计划任务启动我的宏时，Internet Explorer 失去焦点并且发送键在桌面上执行。
我尝试了几件事，包括：
-IE.Visible = 真
-使用Shell对象
执行sendkeys
-尝试过自动化，但我无法使其工作（我不再使用该方法使用 "sendkeys"）。我看到有几个关于堆栈溢出的主题可以帮助我，但我没有成功地使它们工作：
或
- 已尝试 link 下载，但无法正常工作
这是我的代码，我隐藏了重要的字段。请原谅评论中的法语
Option Explicit
'Déclaration pour Sleep
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Public Function Fct_Elemica()
Dim IEObject As InternetExplorer 'Objet Internet Explorer
Dim IEDoc As HTMLDocument 'Document HTML
Dim Shell As Object 'Objet WSScript
'Automations
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Dim iCnd As IUIAutomationCondition
Dim Button As IUIAutomationElement
Dim InvokePattern As IUIAutomationInvokePattern
'Phase de login
Dim InputLogin As HTMLInputElement 'Element HTML pour le controle du champ login
Dim InputPassword As HTMLInputElement 'Element HTML pour le controle du champ password
Dim SubmitButton As HTMLInputElement 'Element HTML pour le controle des boutons d'envoi de formulaire
'Phase de generation du report
Dim ProductSelection As HTMLSelectElement 'Element HTML pour le controle du champ type de produit
Dim DateEndSelection As HTMLInputElement 'Element HTML pour le controle du champ date de fin
'Phase de telechargement du lien
Dim ObjLink As Object 'Element HTML pour le controle des liens href
Dim strDownloadLink As String 'URL du fichier a telecharger
'Variables parametrables
Dim strDownloadFolder As String
Dim strLoginPageURL As String
Dim strLogin As String
Dim strPassword As String
Dim HWNDSrc As Long
Dim h As LongPtr
Dim Child As LongPtr
strDownloadFolder = Nz(DLookup("PAR_TXT_VAL", "tParam", "PAR_LIB = 'DOWNLOAD_PATH'"), "") 'Get the download path
strLoginPageURL = "https://portal.elemica.com/jsp/index.jsp" 'Get the link of the website
strLogin = "**************" 'Login
strPassword = "***********" 'Password
'Instanciation de la varirable IE
Set IEObject = CreateObject("InternetExplorer.Application")
'Affichage de la fenetre IE
IEObject.Visible = True
'Chargement de la page de login du site elemica
IEObject.Navigate strLoginPageURL
'On attend le chargement complet de la page
IE_LOADING_WAIT IEObject
'On pointe la page courante
Set IEDoc = IEObject.Document
'On pointe nos differents controleurs
Set InputLogin = IEDoc.all("username_id")
Set InputPassword = IEDoc.all("passwordID")
Set SubmitButton = IEDoc.all("submitbutton")
'On definit le texte que l'on souhaite placer a l'interieur et on se loggue
InputLogin.value = strLogin
InputPassword.value = strPassword
SubmitButton.Click
'Chargement de la page Expeditions -> Tous
IEObject.Navigate "https://portal.elemica.com/nav?cmd=SRAll&reset=1&groupSelected=-1"
'On attend le chargement complet de la page
IE_LOADING_WAIT IEObject
'On repointe la page courante
Set IEDoc = IEObject.Document
'On entre les valeurs pour parametrer la sortie de l'extraction
Set ProductSelection = IEDoc.getElementsByName("productGroupIDSelected")(0)
Set DateEndSelection = IEDoc.getElementsByName("toDate")(0)
Set SubmitButton = IEDoc.getElementsByName("btnView")(0)
ProductSelection.value = "105"
DateEndSelection.value = Format(Now() + 3, "dd/mm/yyyy")
SubmitButton.Click
'On attend le chargement complet de la page
IE_LOADING_WAIT IEObject
'On interrompt de rafraichissement dynamique
IEObject.Stop
'On recherche le l'adresse du lien "Telecharger dans Excel"
For Each ObjLink In IEDoc.Links
If ObjLink.innerText = "Télécharger dans Excel" Then
strDownloadLink = ObjLink.href
End If
Next ObjLink
'Navigate to the download link
IEObject.Navigate strDownloadLink
'Wait until the page is completely loaded
IE_LOADING_WAIT IEObject
' Set o = New CUIAutomation
' h = IEObject.hWnd
' Sleep 500
' Child = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
' Set e = o.ElementFromHandle(ByVal h)
'
' Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "&Apri")
'
' Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
' Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
' InvokePattern.Invoke
Sleep 500
SendKeys "^j"
Sleep 500
SendKeys "{RIGHT}"
Sleep 500
SendKeys "{RIGHT}"
Sleep 500
SendKeys "{RIGHT}"
Sleep 500
SendKeys "~"
Sleep 500
'Wait until the end of the download
Sleep 20000
'Close IE
IEObject.Quit
Shell ("taskkill /F /IM iexplore.exe")
'Close vars
Set InputLogin = Nothing
Set InputPassword = Nothing
Set SubmitButton = Nothing
Set ProductSelection = Nothing
Set DateEndSelection = Nothing
Set IEDoc = Nothing
Set IEObject = Nothing
Set Shell = Nothing
End Function
Public Function IE_LOADING_WAIT(IEObject As InternetExplorer)
'On boucle tant que la page n'est pas totalement chargee
Do Until IEObject.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
End Function
提前感谢您的回答，祝您愉快！
您可以尝试参考下面的步骤和示例代码，尝试修改您的代码可能有助于解决问题。
复制文件C:\Windows\System32\UIAutomationCore.dll文件给用户文件即C:\Users\admin\Documents然后添加将 UIAutomationClient 引用到您的宏文件。
将以下代码粘贴到您的模块中：
Option Explicit
Dim ie As InternetExplorer
Dim h As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Sub Download()
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Set o = New CUIAutomation
h = ie.Hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
End Sub
参考：
Automate saveas dialogue for IE9 (vba)
我在使用 MS ACCESS 宏在 IE11 中保存下载的文件时遇到问题。
这是我下载后想点击的地方link :
我需要使用用户名/密码登录才能进入该页面。
我目前正在使用 SendKeys 获取文件，当我手动执行我的宏时，它工作得很好。但是，当我使用 Windows 计划任务启动我的宏时，Internet Explorer 失去焦点并且发送键在桌面上执行。
我尝试了几件事，包括：
-IE.Visible = 真
-使用Shell对象
执行sendkeys-尝试过自动化，但我无法使其工作（我不再使用该方法使用 "sendkeys"）。我看到有几个关于堆栈溢出的主题可以帮助我，但我没有成功地使它们工作：
- 已尝试 link 下载，但无法正常工作
这是我的代码，我隐藏了重要的字段。请原谅评论中的法语
Option Explicit
'Déclaration pour Sleep
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Public Function Fct_Elemica()
Dim IEObject As InternetExplorer 'Objet Internet Explorer
Dim IEDoc As HTMLDocument 'Document HTML
Dim Shell As Object 'Objet WSScript
'Automations
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Dim iCnd As IUIAutomationCondition
Dim Button As IUIAutomationElement
Dim InvokePattern As IUIAutomationInvokePattern
'Phase de login
Dim InputLogin As HTMLInputElement 'Element HTML pour le controle du champ login
Dim InputPassword As HTMLInputElement 'Element HTML pour le controle du champ password
Dim SubmitButton As HTMLInputElement 'Element HTML pour le controle des boutons d'envoi de formulaire
'Phase de generation du report
Dim ProductSelection As HTMLSelectElement 'Element HTML pour le controle du champ type de produit
Dim DateEndSelection As HTMLInputElement 'Element HTML pour le controle du champ date de fin
'Phase de telechargement du lien
Dim ObjLink As Object 'Element HTML pour le controle des liens href
Dim strDownloadLink As String 'URL du fichier a telecharger
'Variables parametrables
Dim strDownloadFolder As String
Dim strLoginPageURL As String
Dim strLogin As String
Dim strPassword As String
Dim HWNDSrc As Long
Dim h As LongPtr
Dim Child As LongPtr
strDownloadFolder = Nz(DLookup("PAR_TXT_VAL", "tParam", "PAR_LIB = 'DOWNLOAD_PATH'"), "") 'Get the download path
strLoginPageURL = "https://portal.elemica.com/jsp/index.jsp" 'Get the link of the website
strLogin = "**************" 'Login
strPassword = "***********" 'Password
'Instanciation de la varirable IE
Set IEObject = CreateObject("InternetExplorer.Application")
'Affichage de la fenetre IE
IEObject.Visible = True
'Chargement de la page de login du site elemica
IEObject.Navigate strLoginPageURL
'On attend le chargement complet de la page
IE_LOADING_WAIT IEObject
'On pointe la page courante
Set IEDoc = IEObject.Document
'On pointe nos differents controleurs
Set InputLogin = IEDoc.all("username_id")
Set InputPassword = IEDoc.all("passwordID")
Set SubmitButton = IEDoc.all("submitbutton")
'On definit le texte que l'on souhaite placer a l'interieur et on se loggue
InputLogin.value = strLogin
InputPassword.value = strPassword
SubmitButton.Click
'Chargement de la page Expeditions -> Tous
IEObject.Navigate "https://portal.elemica.com/nav?cmd=SRAll&reset=1&groupSelected=-1"
'On attend le chargement complet de la page
IE_LOADING_WAIT IEObject
'On repointe la page courante
Set IEDoc = IEObject.Document
'On entre les valeurs pour parametrer la sortie de l'extraction
Set ProductSelection = IEDoc.getElementsByName("productGroupIDSelected")(0)
Set DateEndSelection = IEDoc.getElementsByName("toDate")(0)
Set SubmitButton = IEDoc.getElementsByName("btnView")(0)
ProductSelection.value = "105"
DateEndSelection.value = Format(Now() + 3, "dd/mm/yyyy")
SubmitButton.Click
'On attend le chargement complet de la page
IE_LOADING_WAIT IEObject
'On interrompt de rafraichissement dynamique
IEObject.Stop
'On recherche le l'adresse du lien "Telecharger dans Excel"
For Each ObjLink In IEDoc.Links
If ObjLink.innerText = "Télécharger dans Excel" Then
strDownloadLink = ObjLink.href
End If
Next ObjLink
'Navigate to the download link
IEObject.Navigate strDownloadLink
'Wait until the page is completely loaded
IE_LOADING_WAIT IEObject
' Set o = New CUIAutomation
' h = IEObject.hWnd
' Sleep 500
' Child = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
' Set e = o.ElementFromHandle(ByVal h)
'
' Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "&Apri")
'
' Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
' Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
' InvokePattern.Invoke
Sleep 500
SendKeys "^j"
Sleep 500
SendKeys "{RIGHT}"
Sleep 500
SendKeys "{RIGHT}"
Sleep 500
SendKeys "{RIGHT}"
Sleep 500
SendKeys "~"
Sleep 500
'Wait until the end of the download
Sleep 20000
'Close IE
IEObject.Quit
Shell ("taskkill /F /IM iexplore.exe")
'Close vars
Set InputLogin = Nothing
Set InputPassword = Nothing
Set SubmitButton = Nothing
Set ProductSelection = Nothing
Set DateEndSelection = Nothing
Set IEDoc = Nothing
Set IEObject = Nothing
Set Shell = Nothing
End Function
Public Function IE_LOADING_WAIT(IEObject As InternetExplorer)
'On boucle tant que la page n'est pas totalement chargee
Do Until IEObject.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
End Function
提前感谢您的回答，祝您愉快！
您可以尝试参考下面的步骤和示例代码，尝试修改您的代码可能有助于解决问题。
复制文件C:\Windows\System32\UIAutomationCore.dll文件给用户文件即C:\Users\admin\Documents然后添加将 UIAutomationClient 引用到您的宏文件。
将以下代码粘贴到您的模块中：
Option Explicit
Dim ie As InternetExplorer
Dim h As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Sub Download()
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Set o = New CUIAutomation
h = ie.Hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
End Sub
参考：
Automate saveas dialogue for IE9 (vba)