向邮件项添加右键单击选项

本文介绍了向邮件项添加右键单击选项的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 我有一个宏来做一些任务是将打开的mailitem转移到我的硬盘中的特定文件夹。代码如下： 公开 Sub export1（） Const OLTXT = 0 Dim currentExplorer 作为资源管理器 Dim 选择作为选择 Dim oMail As Outlook.MailItem Dim obj 作为 对象 Dim sPath 作为 字符串 Dim dtDate 作为 日期 Dim sName 作为 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， /，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 错误 恢复 下一步 ' 实例化Outlook Application对象。 设置 objOL = CreateObject（ Outlook.Application） ' 获取所选对象的集合。 设置 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 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 NextModule2.SaveAttachmentsEnd SubPrivate 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 SubThis code is belongs to save mail attachments:-Public Sub SaveAttachments()Dim objOL As Outlook.ApplicationDim objMsg As Outlook.MailItem 'ObjectDim objAttachments As Outlook.AttachmentsDim objSelection As Outlook.SelectionDim i As LongDim lngCount As LongDim strFile As StringDim strFolderpath As StringDim 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 NextExitSub:Set objAttachments = NothingSet objMsg = NothingSet objSelection = NothingSet objOL = NothingEnd SubNow 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[^] 这篇关于向邮件项添加右键单击选项的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！