Word和Excel中如何把当前文档作为附件进行邮件发送

'' ==================
''  For Excel
'' ==================
Declare Function MAPISendDocuments Lib "mapi32.dll" (ByVal UIParam As Long, ByVal FileDelimChar As String, ByVal FilePaths As String, ByVal Subject As String, ByVal Reserved As Long) As Integer
Sub 发送附件()
'' Copyright Kingron (2006)
'' 发送附件 Macro
'' 将当前的文件作为附件发送到MAPI邮件程序
''
 On Error Resume Next
 If Workbooks.Count = 0 Then
    MsgBox CSAbout & "当前没有打开的文件，无法发送邮件。", vbOKOnly + vbExclamation
 Else
   ActiveDocument.Save
   MAPISendDocuments 0, ";", ActiveWorkbook.Path + "\" + ActiveWorkbook.Name, "请查收附件：" + ActiveWorkbook.Name, 0
 End If
End Sub
'' 以下是安装工具栏按钮
Const CSToolbarName = "附件"
Const CSBuiltInMailID = 3738 '' Excel 内置邮件按钮的ID
'' 安装工具栏
Private Sub Workbook_AddinInstall()
 On Error Resume Next
 Dim a, b
 '' 查找原来的邮件按钮
 Set a = Application.CommandBars("Standard").FindControl(msoControlButton, CSBuiltInMailID)
 
 '' 查找工具栏按钮是否已经安装，如果已经安装，则不重复添加工具栏按钮
 Set b = Application.CommandBars("Standard").Controls(CSToolbarName)
 If b Is Nothing Then '' 没有按钮
   '' 添加新按钮到原来的Mail按钮后面
   Set b = Application.CommandBars("Standard").Controls.Add(msoControlButton, , , a.Index + 1)
   With b
       '' 设置新增加按钮的属性：动作，风格，文字
       .OnAction = "发送附件"
       .Style = msoButtonIconAndCaption
       .Caption = CSToolbarName
       
       '' 复制 原来发送邮件的图标
       .FaceId = a.FaceId
   End With
 End If
End Sub
'' 卸载工具栏
Private Sub Workbook_AddinUninstall()
   On Error Resume Next
   Application.CommandBars("Standard").Controls(CSToolbarName).Delete
End Sub
''  =============================
'' For Word
'' =============================
Declare Function MAPISendDocuments Lib "mapi32.dll" (ByVal UIParam As Long, ByVal FileDelimChar As String, ByVal FilePaths As String, ByVal Subject As String, ByVal Reserved As Long) As Integer
Sub 发送附件()
'' Copyright Kingron (2006)
'' 发送附件 Macro
'' 将当前的文件作为附件发送到MAPI邮件程序
''
 On Error Resume Next
 If Documents.Count = 0 Then
    MsgBox CSAbout & "当前没有打开的文件，无法发送邮件。", vbOKOnly + vbExclamation
 Else
   ActiveDocument.Save
   MAPISendDocuments 0, ";", ActiveDocument.Path + "\" + ActiveDocument.Name, "请查收附件：" + ActiveDocument.Name, 0
 End If
End Sub
'' 以下是安装工具栏的部分
Const CSToolbarName = "附件"
Const CSBuiltInMailID = 3738 '' 内置邮件按钮的ID
'' 安装工具栏
Private Sub AutoExec()
 On Error Resume Next
 Dim a, b
 '' 查找原来的邮件按钮
 Set a = Application.CommandBars("Standard").FindControl(msoControlButton, CSBuiltInMailID)
 
 '' 查找工具栏按钮是否已经安装，如果已经安装，则不重复添加工具栏按钮
 Set b = Application.CommandBars("Standard").Controls(CSToolbarName)
 If b Is Nothing Then '' 没有按钮
   '' 添加新按钮到原来的Mail按钮后面
   Set b = Application.CommandBars("Standard").Controls.Add(msoControlButton, , , a.Index + 1)
   With b
       '' 设置新增加按钮的属性：动作，风格，文字
       .OnAction = "发送附件"
       .Style = msoButtonIconAndCaption
       .Caption = CSToolbarName
       
       '' 复制 原来发送邮件的图标
       .FaceId = a.FaceId
   End With
 End If
End Sub
'' 卸载工具栏
Private Sub AutoExit()
   On Error Resume Next
   Application.CommandBars("Standard").Controls(CSToolbarName).Delete
End Sub