时间戳

首页 > 解决方案 > 如何在ShellExecute刚刚打开的网页上“键盘焦点”？

vba - 如何在ShellExecute刚刚打开的网页上“键盘焦点”？

问题描述

我使用 . 打开 Outlook 电子邮件中的所有超链接ShellExecute。

我想保存所有打开的网页（我的默认浏览器是 Chrome）。

我试过了SendKeys。我怀疑我需要在ShellExecute前后放置一些代码，SendKeys以便它将打开的网页识别为“活动”。换句话说，我想将键盘焦点设置在打开的 Chrome 网页上。

Private Declare PtrSafe Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long

Sub OpenLinksMessage()
    Dim olMail As Outlook.MailItem
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
    Dim strURL As String
    Dim lSuccess As Long
 
    Set olMail = Application.ActiveExplorer().Selection(1)

    Set Reg1 = New RegExp

    With Reg1
        .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
        .Global = True
        .IgnoreCase = True
    End With

    If Reg1.Test(olMail.Body) Then

        Set M1 = Reg1.Execute(olMail.Body)
        For Each M In M1
            strURL = M.SubMatches(0)
            Debug.Print strURL
            If InStr(strURL, "unsubscribe") Then GoTo NextURL
            If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

            lSuccess = ShellExecute(0, "Open", strURL)
            DoEvents

            'This is where I think I need codes

            SendKeys ("^S"), True
            SendKeys ("name"), True
            SendKeys "{Enter}", True

NextURL:
  
        Next
    End If

    Set Reg1 = Nothing
End Sub

弄清楚这一点后，我将调整代码以循环执行以打开并保存 100 多个链接。

标签： vbagoogle-chromeoutlook

解决方案

我评论说我们可以使用 IE 对象，并做更好的方法来自动化这个过程

但回答你的问题你可以试试

Dim i As Integer

SendKeys ("^S"), True
On Error Resume Next
For i = 1 To 100
    VBA.AppActivate ("Save As")
Next i
On Error GoTo 0
SendKeys ("name"), True
SendKeys "{Enter}", True

推荐阅读