注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

珠海渔郎之电子网档

项目管理 + 程序开发 + Delphi + 电脑应用 + 数码 + 进化感悟

 
 
 

日志

 
 

[存档2006-12-20]Word和Excel中如何把当前文档作为附件进行邮件发送  

2009-07-11 22:45:05|  分类: 电脑应用 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

Office中,必须安装了Outlook之后,才能把当前文档作为附件方式进行发送,而如果没有安装Outlook,那么就没有办法作为附件发送了,因此我们需要一个简单的方式来达到这个实用的功能!

启动Word,新建一个文件,叫做发送附件,保存为.dot文件,然后按Alt+F8,在ThisDocument中保存以下代码。安装方法:把 发送附件.dot 解压缩,存储到Word的Startup目录,解压缩 sendmail.xla 到某个目录,然后启动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

  评论这张
 
阅读(1299)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017