Question

请参阅下面的附图以供参考。

我有一个excel工作簿，我需要在运行中每天输入数据。输入数据后，我需要将数据重新输入到outlook模板中并发送给客户端。

我的Outlook模板包含一张基本表格，如图所示。

我想要做的是在将数据输入excel后，单击按钮，它将自动打开outlook模板，并从excel工作簿中填写数据，准备发送。

我一直在复制和粘贴数据，但它开始失控，因为每天都需要完成数百封这样的电子邮件。

非常感谢任何建议。

Answer 1

这是我用于简单电子邮件的内容 - 非常通用，但您可以根据需要进行调整。

在数据中选择一行并运行宏。调整HEADER_ROW和NUM_COLS常量以适合您的布局。

Sub NotificationMail()

    Const HEADER_ROW As Long = 1 '<< the row with column headers
    Const NUM_COLS As Long = 7   '<< how many columns of data

    Const olMailItem = 0
    Const olFolderInbox = 6

    Dim ol As Object, fldr, ns, msg
    Dim html As String, c As Range, colReq As Long, hdr As Range
    Dim rw As Range

    On Error Resume Next
    Set ol = GetObject(, "outlook.application")
    On Error GoTo 0

    If ol Is Nothing Then
        On Error Resume Next
        Set ol = CreateObject("outlook.application")
        Set ns = ol.GetNamespace("MAPI")
        Set fldr = ns.GetDefaultFolder(olFolderInbox)
        fldr.display
        On Error GoTo 0
    End If

    If ol Is Nothing Then
        MsgBox "Couldn't start Outlook to compose mail!", vbExclamation
        Exit Sub
    End If

    Set msg = ol.CreateItem(olMailItem)

    Set rw = Selection.Cells(1).EntireRow

    msg.Subject = "Here's your information"

    html = "<style type='text/css'>"
    html = html & "body, p {font:10pt calibri;padding:40px;}"
    html = html & "table {border-collapse:collapse}"
    html = html & "td {border:1px solid #000;padding:4px;}"
    html = html & "</style>"

    html = html & "<p>Your request has been updated:</p>"
    html = html & "<table>"


    For Each c In rw.Cells(1).Resize(1, NUM_COLS).Cells
        If c.Column <> 4 Then '<<< EDIT to exclude ColD
            Set hdr = rw.Parent.Cells(HEADER_ROW, c.Column) '<< get the header text for this cell

            html = html & "<tr><td style='background-color:#DDD;width:200px;'>" & _
               hdr.Value & _
               "</td><td style='width:400px;'>" & Trim(c.Value) & "</td></tr>"
        End If 'we want this cell
    Next c

    html = html & "</table>"

    msg.htmlbody = html
    msg.display

End Sub

Answer 2

这是我参考的一些代码

它显示了如何创建表以及如何处理单元格

有很多额外的东西

只需逐步完成

    Sub aTestEmail()

        Dim outMail As Outlook.mailItem
        Set outMail = Application.CreateItem(olMailItem)
        outMail.BodyFormat = olFormatHTML
        outMail.Display (False)                      ' modeless

        Dim wd As Document
'       Set wd = Application.ActiveInspector.WordEditor
        Set wd = outMail.GetInspector.WordEditor

'       wd.Range.InsertBreak 3    ' section (continuous)
'       wd.Range.InsertBreak 3    ' section (continuous)


        For i = 0 To 9
            wd.Range.InsertParagraphAfter
        Next

        debug_aTestEmail wd


        Stop

        Dim rng As Range

        Set rng = wd.Range(2, 8)
        rng.Select
        Debug.Print rng.Text
        rng.Collapse (1)  ' 0 - left, 1 - right
        rng.Select

        wd.Content.Select
 '       Debug.Print wd.Content.Text
 '       wd.Range(wd.Characters(104).End, wd.Characters(150).End).Select
 '       wd.Range(wd.Words(5).Start, wd.Words(10).Start).Select
 '       wd.Range(wd.Words(5).Start, wd.Words(10).End).Select
        wd.Range(wd.Words(5).End, wd.Words(10).End).Select




'        wd.Range.Select
'        wd.Sentences(1).Select
'        wd.Sentences(1).Words(1).Select
'        wd.Sentences(1).Words(5).Select
'        wd.Sentences(1).Words(10).Select


'        wd.Sentences(5).Characters(10).Select
'        wd.Sentences(5).Characters(10).Select
'        wd.Words(10).Select
'        wd.Words(11).Select
'        wd.Range.Words(10).Select
'        wd.Range.Words(11).Select

'        debug_aTestEmail wd
'        wd.Characters(4).Select

        wd.Tables.Add Range:=wd.Characters(8), NumRows:=5, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed

        wd.Tables.Add Range:=wd.Characters(3), NumRows:=5, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed

        wd.Tables(1).Range.Words(1).Select
        wd.Tables(1).Range.Words(2).Select

        wd.Tables(1).Columns(1).Cells(1).Select
        wd.Tables(1).Columns(1).Cells(2).Select
        wd.Tables(1).Columns(1).Cells(3).Select
        wd.Tables(1).Columns(1).Cells(4).Select
        wd.Tables(1).Columns(1).Cells(5).Select


        Debug.Print wd.Sentences(1).Words.Count
        Debug.Print wd.Words.Count

        Dim tabl As Tables
        Set tabl = wd.Tables

        tabl(1).Style = "Grid Table 4 - Accent 3"  ' get this name from "table design" tab (hover over whichever style you like and a tool tip will give you the name)
'       tabl(1).ApplyStyleHeadingRows = True
'       tabl(1).ApplyStyleLastRow = False
'       tabl(1).ApplyStyleFirstColumn = True
'       tabl(1).ApplyStyleLastColumn = False
'       tabl(1).ApplyStyleRowBands = True
'       tabl(1).ApplyStyleColumnBands = False

        tabl(1).Range.InsertParagraph
        tabl(1).Cell(1, 1).Range.InsertParagraph
        tabl(1).Cell(2, 1).Range.InsertParagraph
        tabl(1).Cell(3, 1).Range.InsertParagraph


        tabl(1).Cell(1, 1).Range.InsertBefore "cell1"
        tabl(1).Cell(2, 1).Range.InsertBefore "cell2"
        tabl(1).Cell(3, 1).Range.InsertBefore "cell3"
        tabl(1).Cell(4, 1).Range.InsertBefore "cell4"
        tabl(1).Cell(5, 1).Range.InsertBefore "cell5"

        tabl(2).Cell(1, 1).Range.InsertBefore "cell6"
        tabl(2).Cell(2, 1).Range.InsertBefore "cell7"
        tabl(2).Cell(3, 1).Range.InsertBefore "cell8"
        tabl(2).Cell(4, 1).Range.InsertBefore "cell9"
        tabl(2).Cell(5, 1).Range.InsertBefore "cell10"


'        wd.Range.InsertBreak 3 ' section (continuous)
'        wd.Range.InsertBreak 3 ' section (continuous)

        debug_aTestEmail wd

'        wd.Sections(2).Range.InsertBefore ("before" & vbCrLf & vbCrLf)
'        wd.Sections(2).Range.InsertAfter ("after" & vbCrLf & vbCrLf)

'        debug_aTestEmail wd

'        wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.1" & vbCrLf & vbCrLf)
'        wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.2" & vbCrLf & vbCrLf)
'        wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.3" & vbCrLf & vbCrLf)
'        wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.4" & vbCrLf & vbCrLf)

'        For i = 1 To wd.Sections(1).Range.Words.Count
'            Debug.Print wd.Sections(1).Range.Words(i).Characters.Count & " ";
'            Debug.Print wd.Sections(1).Range.Words(i) & " "
'        Next


'        debug_aTestEmail wd

'        wd.Sections(2).Range.InsertAfter ("after2.1" & vbCrLf & vbCrLf)
'        wd.Sections(2).Range.InsertAfter ("after2.2" & vbCrLf & vbCrLf)
'        wd.Sections(2).Range.InsertAfter ("after2.3" & vbCrLf & vbCrLf)
'        wd.Sections(2).Range.InsertAfter ("after2.4" & vbCrLf & vbCrLf)

        Set wd = Nothing
        Set outMail = Nothing
    End Sub


    Sub debug_aTestEmail(wd As Document)

        Debug.Print "------------------------------------------------"
        Debug.Print "   wd.Sections.Count : " & wd.Sections.Count
        Debug.Print " wd.Paragraphs.Count : " & wd.Paragraphs.Count
        Debug.Print "  wd.Sentences.Count : " & wd.Sentences.Count
        Debug.Print "      wd.Words.Count : " & wd.Words.Count
        Debug.Print " wd.Characters.Count : " & wd.Characters.Count
        Debug.Print "        wd.Range.End : " & wd.Range.End
        Debug.Print "wd.StoryRanges.Count : " & wd.StoryRanges.Count
        Debug.Print "------------------------------------------------"

        Debug.Print wd.Tables.Count


    End Sub

Excel工作簿到Outlook模板

2 个答案: