Question

我有一些代理商，需要填写销售表格，该表格将转到另一个注册的代理商。因此，当座席单击按钮时，我为按钮设置了脚本，它会向其他座席发送电子邮件，但是我不确定如何包含电子表格数据。

我该怎么做？

这是我一直在使用的代码：

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

Answer 1

如果您不想附加工作表，而只是显示数据（并假设可以用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替换为要发送的数据范围即可：

activesheet.usedRange

更新：要不使用html格式发送数据：

 With NewMail
    ...
    .HTMLBody = "<h1>Here is your data</h1>" & RangeToHtmlTable(activesheet.usedRange)
end with

不发送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。使用可选参数.HTMLBody，您可以定义要在单元格之间显示的内容（例如separator）

"; "

宏，可使用带有电子表格内容的Gmail发送电子邮件

1 个答案: