Office/Excel2013
Office/Outlook2013
创建一个名字为“出货清单”Excel表单，先制作一个出货记录表格。您可按需要自行制作，做成一行一条目。在正常内容最后加一行用于选择是否需要自动发送邮件。
再增加一个名字为'清单'的Excel表单。用于列举各项常用重复内容。例子中列举出货地址清单，联系人联系方式清单，还有料号清单。
对各个清单定义范围。这里以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)
通过定义的清单来校验数据， 从而保证误输入。通过下来选择也可提高效率。
新建一个名为“模板”的Excel表单，定义要通过邮件发送的内容的模板。后续会通过宏来拷贝模板，填充内容，调用outlook发送。 注意。 模板请放在第一行以下，因为第一行会用与拷贝发送内容过来做转制。
按如下图片步骤录制一个名为'shipment'的宏。宏的录制是录制单条操作的内容，操作内容根据自己需要按步骤录制。多条循环操作需稍微加几句代码。下一步骤会介绍。 如下代码供参考：Sub shipment()' shipment arrangement '如下为录制内容 Sheets('出货记录').Select Range('B3:I3').Select Application.CutCopyMode = False Selection.Copy Sheets('邮件模板').Select Range('A1').Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,SkipBlanks _ :=False, Transpose:=False Range('G3:H12').Select Application.CutCopyMode = False Selection.Copy Range('A3').Select Selection.Insert Shift:=xlDown Range('B3').Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = '=R[-2]C[-1]' Range('B4').Select ActiveCell.FormulaR1C1 = '=R[-3]C[1]' Range('B5').Select ActiveCell.FormulaR1C1 = '=R[-4]C[2]' Range('B6').Select ActiveCell.FormulaR1C1 = '=R[-5]C' Range('B7').Select ActiveCell.FormulaR1C1 = '=R[-6]C[4]' Range('B8').Select ActiveCell.FormulaR1C1 = '=R[-7]C[5]' Range('B9').Select ActiveCell.FormulaR1C1 = '=R[-8]C[3]' Range('B10').Select ActiveCell.FormulaR1C1 = '=R[-9]C[6]' Range('B3:B10').Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,SkipBlanks _ :=False, Transpose:=False Range('A1:H1').Select Application.CutCopyMode = False Selection.ClearContents Sheets('出货记录').Select Range('J3').Select ActiveCell.FormulaR1C1 = 'Closed' Range('A3:J3').Select Range('J3').Activate With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.4526 .PatternTintAndShade = 0 End With'如上为录制内容End Sub
打开录制的宏添加循环代码。按图片步骤及语句在录制范围前后添加循环代码。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
录制范围部分代码需按图片更新成变量。
再添加邮件发送代码，其中有定义一个名为的 RangetoHTML（）的函数。 ' 以下语段用于发送邮件 Sheets('出货记录').Select If g = '0' Then MsgBox 'No new shippment set to Y ' Else g = 10 * g + 2 Dim OutApp As Object Dim OutMail As Object Dim MailBody As Range Sheets('邮件模板').Select Set MailBody = Range('A3:B' & g) Set OutApp = CreateObject('Outlook.Application') Set OutMail = OutApp.CreateItem(olMailItem) On Error Resume Next With OutMail .to = 'Mama@aimama.com' .CC = '' .BCC = '' .Subject = 'Shipment Arrangement' .BodyFormat = Outlook.OlBodyFormat.olFormatHTML .HTMLBody = RangetoHTML(MailBody) .Display End With On Error GoTo 0 End If Sheets('出货记录').Select Application.ScreenUpdating = True
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
代码完成。 只需创建一个按钮方便调用此宏即可。
增加条目后把对应行内邮件通知列改成'Y',然后点“发送邮件”按钮即可弹出邮件并出货通知表单内更改状态。
最好是有一定的VBA基础，没有就仔细看里面的公式就能明白什么意思。
如果觉得本经验给您带来一点帮助或启发，请点页面右上角大拇指及五角星图标。感谢感谢！