Question

我正在尝试编写一个宏来从工作表中获取打印屏幕，然后将其粘贴到新的电子邮件中。这里的诀窍是，我不想将图像作为附件发送，我希望它在身体上。

这是我到目前为止所得到的，但我不知道如何将图像粘贴到身体上。

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

提前谢谢！

Answer 1

虽然我讨厌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检查并返回给您。

VBA - PrintScreen然后粘贴电子邮件

1 个答案: