操作方法
创建一个名字为“出货清单”Excel表单，先制作一个出货记录表格。 您可按需要自行制作，做成一行一条目。 在正常内容最后加一行用于选择是否需要自动发送邮件。
再增加一个名字为"清单"的Excel表单。用于列举各项常用重复内容。 例子中列举出货地址清单，联系人联系方式清单，还有料号清单。
对各个清单定义范围。这里以PNlist 命名来定义举一例，各位可按需定义。 料号清单范围定义 =清单!$G$2:OFFSET(清单!$G$1,COUNTA(清单!$G:$G)-1,0) COUNTA(清单!$G:$G) 是用于计算G列有多少行有内容，即有多少个P/N清单。 例子计算结果为4 OFFSET($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.149998474074526 .PatternTintAndShade = 0 End With '如上为录制内容 End Sub
打开录制的宏添加循环代码。 按图片步骤及语句在录制范围前后添加循环代码。 Dim i As Integer Dim j As Integer Dim g As Integer Application.ScreenUpdating = False Sheets("出货记录").Select i = 1 j = Application.WorksheetFunction.CountA(Range("A:A")) + 1 g = 0 '变量i 用于循环，变量j用于判断有多少行需要循环，变量g 用于邮件发送时定义有多少行需要发送 For i = 1 To j If Range("j" & i).Value = "Y" Then '如下为录制内容 ------------- '如上为录制内容 g = g + 1 Else End If Next 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 =(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=center x:publishsource=", _ "align=left x:publishsource=") TempWB.Close savechanges:=False Kill TempFile Set ts = Nothing Set fso = Nothing Set TempWB = Nothing End Function
代码完成。 只需创建一个按钮方便调用此宏即可。
增加条目后把对应行内邮件通知列改成"Y",然后点“发送邮件”按钮即可弹出邮件并出货通知表单内更改状态。