向邮件项添加右键单击选项 [英] Add right click option to mail item

问题描述

我有一个宏来做一些任务是将打开的mailitem转移到我的硬盘中的特定文件夹。代码如下：

 公开  Sub  export1（）
  Const  OLTXT =  0  
  Dim  currentExplorer 作为资源管理器
  Dim 选择作为选择
 < span class =code-keyword> Dim  oMail  As  Outlook.MailItem 
  Dim  obj 作为 对象 
  Dim  sPath 作为 字符串 
  Dim  dtDate 作为 < span class =code-keyword>日期 
  Dim  sName 作为 < span class =code-keyword> String  
 
 
 设置 currentExplorer = Application.ActiveExplorer 
 设置 Selection = currentExplorer.Selection 
 
 对于 每个 obj 在选择
 设置 oMail = obj 
 sName = oMail.Subject 
 ReplaceCharsForFileName sName，  _ 
 
 dtDate = oMail.ReceivedTime 
 sName =格式（dtDate，  yyyymmdd，vbUseSystemDayOfWeek ，_ 
 vbUseSystem）&格式（dtDate，   -  hhnnss，_ 
 vbUseSystemDayOfWeek，vbUseSystem）&    - & sName&  。html 
 
 oMail.SaveAs   D：\ macro \& sName，OLTXT 
 
 下一步 
 
 Module2.SaveAttachments 
 
 结束  Sub  
 
 私人  Sub  ReplaceCharsForFileName（sName  As   String ，_ 
 sChr 作为 字符串 _ 
）
 sName =替换（sName，< span class =code-string>  /，sChr）
 sName = Replace（sName，  \，sChr）
 sName = Replace（sName， ：，sChr）
 sName =替换（sName， ？，sChr）
 sName =替换（sName，Chr（ 34 ），sChr）
 sName =替换（sName， <，sChr）
 sName = Replace （sName， >，sChr）
 sName = Replace（sName，  |，sChr）
 结束  Sub  

此代码属于保存邮件附件： -

 公共  Sub  SaveAttachments（）
  Dim  objOL  As  Outlook.Application 
  Dim  objMsg  As  Outlook.MailItem '  Object  
  Dim  objAttachments  As  Outlook.Atta chments 
  Dim  objSelection  As  Outlook.Selection 
  Dim  i 作为 长 
  Dim  lngCount 作为 长 
  Dim  strFile 作为 字符串 
  Dim  strFolderpath 作为 字符串 
  Dim  strDeletedFiles 作为 字符串 
 
  获取我的文档文件夹的路径 
 strFolderpath = CreateObject（  WScript .Shell）。SpecialFolders（ 16 ）
  On  错误 恢复 下一步 
 
 < span class =code-comment>' 实例化Outlook Application对象。 
 设置 objOL = CreateObject（  Outlook.Application）
 
 < span class =code-comment>' 获取所选对象的集合。 
 设置 objSelection = objOL.ActiveExplorer.Selection 
 
 ' 附件文件夹需要存在 
 ' 您可以将其更改为您选择的其他文件夹名称 
 
 ' 设置附件文件夹。 
 strFolderpath =    D：\ macro \ 
 
 ' 检查每个所选项目的附件。 
 对于 每个 objMsg 在 objSelection 
 
 设置 objAttachments = objMsg.Attachments 
 lngCount = objAttachments.Count 
 
 如果 lngCount>  0  然后 
 
 ' 使用倒计时循环删除项目 
 ' 来自一个集合。否则，循环计数器 
 ' 混淆，只删除所有其他项目。 
 
 对于 i = lngCount 至  1  步骤 -1 
 
 ' 获取文件名。 
 strFile = objAttachments.Item（i）.FileName 
 
 '  结合Temp文件夹的路径。 
 strFile = strFolderpath& strFile 
 
 ' 将附件保存为文件。 
 objAttachments .Item（i）.SaveAsFile strFile 
 
  Next  i 
 MsgBox  保存在D：\ macro中附件 
 否则 
 MsgBox  邮件被保存，此选择邮件没有附件 
 结束 如果 
 
 下一步 
 
 ExitSub：
 
 设置 objAttachments =  Nothing  
 设置 objMsg =  Nothing  
 设置 objSelection = 没什么 
  Set  objOL =  Nothing  
 
 结束  Sub  

< br $> b $ b



现在我想在选择此代码必须执行的名称后右键单击mailitem时添加特定名称。我需要做什么请帮助我找到解决方案。

解决方案

你不能使用VBA添加上下文菜单。

你需要创建COM Addin。这是一个想法：如何添加上下文菜单按钮 [ ^ ]



更多信息，请参阅：在Outlook 2010中扩展用户界面 [ ^ ]

I have a macro to do some task is that transfer the opened mailitem to specific folder in my hard drive.That code is like:

Public Sub export1()
Const OLTXT = 0
  Dim currentExplorer As Explorer
  Dim Selection As Selection
  Dim oMail As Outlook.MailItem
  Dim obj As Object
  Dim sPath As String
  Dim dtDate As Date
  Dim sName As String


  Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection

 For Each obj In Selection
  Set oMail = obj
  sName = oMail.Subject
  ReplaceCharsForFileName sName, "_"

  dtDate = oMail.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "-hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".html"

  oMail.SaveAs "D:\macro\" & sName, OLTXT

  Next

Module2.SaveAttachments

End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

This code is belongs to save mail attachments:-

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

' The attachment folder needs to exist
' You can change this to another folder name of your choice

    ' Set the Attachment folder.
    strFolderpath = "D:\macro\"

    ' Check each selected item for attachments.
    For Each objMsg In objSelection

    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then

    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.

    For i = lngCount To 1 Step -1

    ' Get the file name.
    strFile = objAttachments.Item(i).FileName

    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile

    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile

    Next i
    MsgBox "saved in D:\macro with attachments"
    Else
    MsgBox "mail is saved and no attachments for this selection mail"
    End If

    Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing

End Sub

Now i want to add specific name to when i right click on mailitem after selecting the name this code has to execute.for doing this what i need to do please help me to find a solution.

解决方案

You can't add context menu using VBA.
You need to create COM Addin. Here is an idea: How to add context menu buttons[^]

For further information, please see: Extending the User Interface in Outlook 2010[^]

这篇关于向邮件项添加右键单击选项的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！