Код Outlook VBA для «Фокус клавиатуры» на веб-странице (Chrome), которая была только что открыта ShellExecute - PullRequest
Новая
       49

Код Outlook VBA для «Фокус клавиатуры» на веб-странице (Chrome), которая была только что открыта ShellExecute

0 голосов
/ 18 апреля 2019

Outlook VBA

Я пытаюсь открыть все гиперссылки в электронном письме Outlook, а затем сохранить все открытые веб-страницы (к вашему сведению: мой браузер по умолчанию - Chrome). Я уже смог открыть все гиперссылки, используя ShellExecute; однако когда я попытался сделать 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 ссылок.

Спасибо за помощь заранее.

1 Ответ

0 голосов
/ 18 апреля 2019

Я прокомментировал, что мы можем использовать объект 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
...