Excel 宏使用Gmail发送包含电子表格内容的电子邮件

我有一些代理人需要填写一份销售表格，然后交给另一个进行注册的代理人。因此，我为一个按钮设置了一个脚本，当代理单击它时，它会向另一个代理发送一封电子邮件，但我不确定如何包含电子表格数据

我该怎么做

以下是我一直使用的代码：

Sub sendemail()

    On Error GoTo Err

    Dim NewMail As Object
    Dim mailConfig As Object
    Dim fields As Variant
    Dim msConfigURL As String

    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")

    ' load all default configurations
    mailConfig.Load -1
    Set fields = mailConfig.fields

    'Set All Email Properties
    With NewMail
        .Subject = "Sales Follow up"
        .From = ""
        .To = ""
        .CC = ""
        .BCC = ""
    End With

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        'Enable SSL Authentication
        .Item(msConfigURL & "/smtpusessl") = True

        'Make SMTP authentication Enabled=true (1)
        .Item(msConfigURL & "/smtpauthenticate") = 1

        'Set the SMTP server and port Details
        'To get these details you can get on Settings Page of your Gmail Account
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2

        'Set your credentials of your Gmail Account
        .Item(msConfigURL & "/sendusername") = "********"
        .Item(msConfigURL & "/sendpassword") = "********"

        'Update the configuration fields
        .Update
    End With

    NewMail.Configuration = mailConfig
    NewMail.send
    MsgBox ("Mail has been Sent")

Exit_Err:

    Set NewMail = Nothing
    Set mailConfig = Nothing
    End

Err:


    Select Case Err.Number
        Case -2147220973  'Could be because of Internet Connection
            MsgBox " Could be no Internet Connection !!  -- " & Err.Description
        Case -2147220975  'Incorrect credentials User ID or password
            MsgBox "Incorrect Credentials !!  -- " & Err.Description
        Case Else   'Rest other errors
            MsgBox "Error occured while sending the email !!  -- " & Err.Description
    End Select

    Resume Exit_Err

End Sub

---

如果您不想附加工作表，只想显示数据（并且假设可以用HTML发送邮件）：

以下函数从Excel范围创建html表

Function RangeToHtmlTable(r As Range)

    Dim data, row As Long, col As Long, html As String
    data = r.Value2
    html = "<table>"
    For row = 1 To UBound(data, 1)
        html = html & "<tr>"
        For col = 1 To UBound(data, 2)
            html = html & "<td>" & data(row, col) & "</td>"
        Next col
        html = html & "</tr>" & vbCrLf
    Next row
    html = html & "</table>"
    RangeToHtmlTable = html
End Function

更新：要发送不带html格式的数据：

Function RangeToTable(r As Range, Optional separator As String = vbTab)

    Dim data, row As Long, col As Long, table As String
    data = r.Value2
    table = ""
    For row = 1 To UBound(data, 1)
        For col = 1 To UBound(data, 2)
            table = table & data(row, col) & separator
        Next col
        table = table & vbCrLf
    Next row
    RangeToTable = table
End Function

不发送html时，应将文本分配给

.TextBody

，而不是

.HTMLBody

。使用可选参数

分隔符

，您可以定义要在单元格之间显示的内容（例如，

“；”

）

---

我不明白这里发生了什么变化。我需要在电子邮件正文中发送活动工作表。这有点紧急。任何帮助都会很好！提前谢谢。您试过

.AddAttachment

吗？没有。我不想添加它作为附件。Juat没有在工作表上显示的数据会出现在电子邮件中吗？这是否适用于我所编写的当前代码？对我来说，它起作用了-试试看。不要忘记将

从

和

设置为

。这样它就可以工作了！现在我只是有一些格式问题的电子邮件，如只是粗体文本。我不知道如何设置我想要发送的信息的范围。这就是我想要看到的。这就是我所看到的。您可以将工作表作为附件发送，也可以自己用html进行格式化。我看没有别的办法了。

Function RangeToTable(r As Range, Optional separator As String = vbTab)

    Dim data, row As Long, col As Long, table As String
    data = r.Value2
    table = ""
    For row = 1 To UBound(data, 1)
        For col = 1 To UBound(data, 2)
            table = table & data(row, col) & separator
        Next col
        table = table & vbCrLf
    Next row
    RangeToTable = table
End Function

.TextBody = "Here is your data:" & vbrLf & vbCrLf & RangeToTable(activesheet.usedRange)