1

我正在尝试从工作表中获取 PrintScreen，然后将其粘贴到新电子邮件中。

我希望它在身体中而不是作为附件。我不知道如何将图像粘贴到正文中。

Sub SetRecipients()
    Dim aOutlook As Object
    Dim aEmail As Object
    Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String

    Application.SendKeys "(%{1068})"
    DoEvents

    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    Set rngeAddresses = ActiveSheet.Range("A3:A13")
    For Each rngeCell In rngeAddresses.Cells
        strRecipients = "email.test@gmail.com" 'strRecipients & ";" & rngeCell.Value
    Next
    aEmail.Subject = "Indicator activity warning ( TestMailSend )"
    aEmail.Body = ********* DONT KNOW *******
    aEmail.To = strRecipients
    aEmail.Send

End Sub
4

1 回答 1

3

虽然我讨厌Sendkeys，但这有效......

Sub SetRecipients()
    Dim aOutlook As Object, aEmail As Object
    Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String

    Application.SendKeys "(%{1068})"
    DoEvents

    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    Set rngeAddresses = ActiveSheet.Range("A3:A13")

    For Each rngeCell In rngeAddresses.Cells
        strRecipients = "email.test@gmail.com" 'strRecipients & ";" & rngeCell.Value
    Next

    aEmail.Subject = "Indicator activity warning ( TestMailSend )"
    aEmail.To = strRecipients
    aEmail.display '<~~ This is required so we can send keys to it

    Wait 2 '<~~ wait for 2 seconds for email to get displayed

    SendKeys "^({v})", True '<~~ Paste

    DoEvents '<~~ Waiting for paste to happen

    '~~> Finally send
    aEmail.send

    Set aOutlook = Nothing
    Set aEmail = Nothing
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

编辑：使用 SendMessage API 可能有更好的方法，Lemme 检查并回复您。

于 2013-09-20T15:55:05.203 回答