VBA: заполнить ввод в веб-Outlook

Question

Заполните поле «Кому» «Cc» «Тема» «Сообщение» в веб-Outlook

URL-адрес OWA: «https://outlook.office.com/mail/deeplink/compose?version=2020051702.05&popoutv2=1&leanbootstrap=1»

Тег «Вход» для «Кому» (в качестве примера): <input autocapitalize="off" autocomplete="off" aria-autocomplete="both" aria-label="To" class="ms-BasePicker-input pickerInput_8d9d7e4e" aria-expanded="false" aria-haspopup="true" role="combobox" data-lpignore="true" value="" tabindex="0">

Как мне написать свой VBA, чтобы назначить адрес электронной почты части значения OWA?

Мой код следующий:

        Dim objIE As Object, i As Long, html As Object

        'Creare Internet Explorer
        Set objIE = CreateObject("InternetExplorer.Application")
        With objIE
            .Visible = True 'true
            .Silent = True
            .Navigate "https://outlook.office.com/mail/deeplink/compose?version=2020051702.05&popoutv2=1&leanbootstrap=1"
            While .Busy = True Or .ReadyState < 4: DoEvents: Wend
            Set html = .Document
            html.querySelector("input[aria-label='To']").value = "XXX@email.com"
        End With

Answer 1

Привет, в моем предыдущем ответе я использовал обходной путь, хаха, извините, вы можете использовать следующий код для ввода в веб-форму, используя ie.document.getElementById("name").Value = objItem.SenderName

Sub HelpdeskNewTicket()
Dim helpdeskaddress As String
Dim objMail As Outlook.MailItem
Dim strbody As String
Dim oldmsg As String
Dim senderaddress As String
Dim addresstype As Integer
Dim ie         As Object
Dim sResult    As String
Dim dtTimer    As Date
Dim lAddTime   As Long


Set objItem = GetCurrentItem()


' Sender E=mail Address
senderaddress = objItem.SenderEmailAddress

'Searches for @ in the email address to determine if it is an exchange user
addresstype = InStr(senderaddress, "@")

' If the address is an Exchange DN use the Senders Name
If addresstype = 0 Then
senderaddress = objItem.SenderName
End If


   Const sOVIDURL As String = "http://helpdesk.com/admin"
   Const lREADYSTATE_COMPLETE As Long = 4

      Set ie = CreateObject("InternetExplorer.Application")
      ie.Visible = True
      ie.navigate sOVIDURL

      dtTimer = Now
      lAddTime = TimeValue("00:00:20")

      Do Until ie.readystate = lREADYSTATE_COMPLETE And Not ie.busy
      DoEvents
      If dtTimer + lAddTime > Now Then Exit Do
      Loop

      ie.document.getElementById("user").Value = "yourusername"
      ie.document.getElementById("password").Value = "yourpassword"
      ie.document.forms(0).submit

      Do Until ie.readystate = lREADYSTATE_COMPLETE And Not ie.busy
      DoEvents
      If dtTimer + lAddTime > Now Then Exit Do
      Loop

      ie.navigate "http://helpdesk.com/admin/new_ticket.php"

      Do Until ie.readystate = lREADYSTATE_COMPLETE And Not ie.busy
      DoEvents
      If dtTimer + lAddTime > Now Then Exit Do
      Loop

               While ie.busy
            DoEvents
         Wend

      ie.document.getElementById("name").Value = objItem.SenderName
      ie.document.getElementById("subject").Value = objItem.Subject
      ie.document.getElementById("message").Value = objItem.Body
      dtTimer = Now
      lAddTime = TimeValue("00:00:20")
   Set ie = Nothing ' If you want to close it.


'Dim PageNumber As Object


Set objItem = Nothing
Set objMail = Nothing
End Sub

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.currentItem
Case Else
End Select
End Function

Answer 2

Вам понадобится что-то под названием CDO. Проверьте код ниже, чтобы установить электронную почту и электронную почту с помощью CDO. Он не зависит от MAPI или CDO и, следовательно, не требует диалогов и не использует вашу почтовую программу для отправки электронных писем.

Зачем использовать код CDO вместо автоматизации Outlook или SendMail в VBA?

1. Неважно, какую почтовую программу вы используете (она использует только SMTP-сервер).
2. Неважно, какую версию Office вы используете (97… 2016)
3. Вы можете отправить диапазон / лист в теле письма (некоторые почтовые программы не могут этого сделать)
4. Вы можете отправить любой понравившийся файл (файлы Word, PDF, PowerPoint, TXT,….)
5. Нет предупреждений о безопасности, действительно здорово, если вы отправляете много почты на al oop.

вы можете найти дополнительную информацию здесь

 Sub SendMessage(Subject As String, Recipient As String, Body As String, User As String, Password As String)
   Dim sReq As String
   Dim xmlMethod As String
   Dim XMLreq As New MSXML2.XMLHTTP60
   Dim EWSEndPoint As String
   EWSEndPoint = "https://outlook.office365.com/EWS/Exchange.asmx"
   sReq = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
   sReq = sReq & "<soap:Envelope xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:t=""http://schemas.microsoft.com/exchange/services/2006/types"">" & vbCrLf
   sReq = sReq & "<soap:Header>" & vbCrLf
   sReq = sReq & "<t:RequestServerVersion Version=""Exchange2010""/>" & vbCrLf
   sReq = sReq & "</soap:Header>" & vbCrLf
   sReq = sReq & "<soap:Body>" & vbCrLf
   sReq = sReq & "<CreateItem MessageDisposition=""SendAndSaveCopy"" xmlns=""http://schemas.microsoft.com/exchange/services/2006/messages"">" & vbCrLf
   sReq = sReq & "<SavedItemFolderId>" & vbCrLf
   sReq = sReq & "<t:DistinguishedFolderId Id=""sentitems"" />" & vbCrLf
   sReq = sReq & "</SavedItemFolderId>" & vbCrLf
   sReq = sReq & "<Items>" & vbCrLf
   sReq = sReq & "<t:Message>" & vbCrLf
   sReq = sReq & "<t:ItemClass>IPM.Note</t:ItemClass>" & vbCrLf
   sReq = sReq & "<t:Subject>" & Subject & "</t:Subject>" & vbCrLf
   sReq = sReq & "<t:Body BodyType=""Text"">" & Body & "</t:Body>" & vbCrLf
   sReq = sReq & "<t:ToRecipients>" & vbCrLf
   sReq = sReq & "  <t:Mailbox>" & vbCrLf
   sReq = sReq & "       <t:EmailAddress>" & Recipient & "</t:EmailAddress>" & vbCrLf
   sReq = sReq & "  </t:Mailbox>" & vbCrLf
   sReq = sReq & "</t:ToRecipients>" & vbCrLf
   sReq = sReq & "</t:Message>" & vbCrLf
   sReq = sReq & "</Items>" & vbCrLf
   sReq = sReq & "</CreateItem>" & vbCrLf
   sReq = sReq & "</soap:Body>" & vbCrLf
   sReq = sReq & "</soap:Envelope>" & vbCrLf
   xmlMethod = "POST"
   XMLreq.Open xmlMethod, EWSEndPoint, False, User, Password
   XMLreq.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
   XMLreq.setRequestHeader "Translate", "F"
   XMLreq.setRequestHeader "User-Agent", "Blah"
   XMLreq.send sReq
   If XMLreq.Status = 207 Then
   End If
End Sub