办公自动化之-通过Excel自动发送电子邮件

1、创建一个名字为“出货清单”Excel表单，先制作一个出货记录表格。您可按需要自行制作，做成一行一条目。在正常内容最后加一行用于选择是否需要自动发送邮件。

3、对各个清单定义范围。这里以PNlist 命名来定义举一例，各位可按需定义。料号清单范围定义=清单!$G$2:OFFSET(清单!$G$1,COUNTA(清单!$G:$G)-1,0)COUNTA(清单!$G:$G)是用于计算G列有多少行有内容，即有多少个P/N清单。例子计算结果为4OFFSET($G$1,4-1，0）计算结果即为$G$4.所以PNlist 就被成功定义为=清单!$G$2:$G$4定义地址清单：Addresslist =清单!$A$2:offset($A$1,counta($A:$A)-1,1)定义联系人清单：Namelist=清单!$D$2:OFFSET(清单!$D$1,COUNTA(清单!$D:$D)-1,1)

5、新建一个名为“模板”的Excel表单，定义要通过邮件发送的内容的模板。后续会通过宏来拷贝模板，填充内容，调用outlook发送。注意。 模板请放在第一行以下，因为第一行会用与拷贝发送内容过来做转制。

7、打开录制的宏添加循环代码。按图片步骤及语甜入艺阝句在录制范围前后添加循环代码。Dim i As IntegerDim j As IntegerDim g As IntegerApplication.ScreenUpdating = FalseSheets("出货记录").Selecti = 1j = Application.WorksheetFunction.CountA(Range("A:A")) + 1g = 0'变量i 用于循环，变量j用于判断有多少行需要循环，变量g 用于邮件发送时定义有多少行需要发送For i = 1 To j If Range("j" & i).Value = "Y" Then'如下为录制内容-------------'如上为录制内容 g = g + 1 Else End IfNext i

8、录制范围部分代码需按图片更新成变量。

10、RangetoHTML（）的函数 代码申明将如下代码拷贝粘帖到End Sub()之后Public Function RangetoHTML(rng As Range) 肛舀辨乔Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" rng.Copy Set TempWB = Workbooks.Add(1) With TempWB.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With With TempWB.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=TempFile, _ Sheet:=TempWB.Sheets(1).Name, _ Source:=TempWB.Sheets(1).UsedRange.Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close RangetoHTML = Replace(RangetoHTML, "align=centerx:publishsource=", _"align=left x:publishsource=") TempWB.Close savechanges:=FalseKill TempFileSet ts = Nothing Set fso = Nothing Set TempWB = NothingEnd Function

12、增加条目后把对应行内邮件通知列改成"Y",然后点“发送邮件”按钮即可弹出邮件并出货通知表单内更改状态。