- wpsppt制作教程:wps office公式怎么写
- word文档排版教程:如何在 OneNote 中创建表单时使用内容控件
- wps制作表格教程:WPS表格办公#8212;根据单元格颜色进行排序
- wps修改图片颜色教程:wps怎样插入项目符号
outlook有个特别不符合国人习惯的小问题:即使发件人已经添加到了联系人地址簿中,在收件箱中查看邮件列表时,发件人栏显示的依然是对方自定义的名字,整体看起来很杂乱。
百般查找也没找到设置方法和合适的插件。写了个宏脚本,暂时实现了替换收件箱中邮件列表发件人的功能。
最近工作忙,先凑合用着,以后有时间再完善人机交互方案。
使用方法
在outlook选项中使能开发工具页面,打开VB编辑开发窗口。添加新的模块,在模块的编辑界面贴入下面的代码。运行宏即可。
详细代码
代码中的write #1等是注释代码,可以都删掉。
函数1
函数updatesendername输入为收件箱中的没封邮件,函数功能是判断发件人类型是否是exchange,如果是,则可以获取到exchange通讯录中的信息,word零基础教程,使用信息替换发件人名称(exchange通讯录类中的可用字段可以参考outlook vb的帮助文档)
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
Function mail_rename_sender(ByVal Item As Object, ByVal log As Boolean)
Dim myItem As Outlook.MailItem
Dim tmpPos As Integer
Dim tmpFlag As String
Set myItem = Item
If log Then
Write #1, '写入空白行。
Write #1, myItem.SenderEmailAddress, myItem.SentOnBehalfOfName, myItem.SenderEmailType, myItem.SenderName, myItem.SendUsingAccount, TypeName(myItem.sender)
End If
If myItem.SenderEmailType = "EX" Then
Dim oExUser As Outlook.ExchangeUser
Set oExUser = myItem.sender.GetExchangeUser
If log Then
Write #1, "11111", oExUser.Address, oExUser.PrimarySmtpAddress, oExUser.FirstName, oExUser.LastName, oExUser.Name
End If
If InStr(oExUser.OfficeLocation, "未来") <> 0 Then
tmpFlag = "$"
tmpPos = 10
Else
tmpPos = InStr(oExUser.OfficeLocation, "(")
'MsgBox (tmpPos)
If tmpPos = 0 Then
tmpPos = 11
Else
tmpPos = tmpPos - 1
End If
tmpFlag = "*"
End If
myItem.SentOnBehalfOfName = tmpFlag & " " & oExUser.LastName & "(" & oExUser.Alias & ")@" & "[" & Left(oExUser.OfficeLocation, tmpPos) & "]" '"-" & oExUser.CompanyName & "]"
Else
If TypeName(myItem.sender) = "AddressEntry" Then '发件人在联系人中
Set itemContact_temp = myItem.sender.GetContact()
If itemContact_temp Is Nothing Then
If log Then
Write #1, "77777777777777777777", myItem.Subject
End If
Else
If log Then
Write #1, "2222222", itemContact_temp.Email1Address
End If
myItem.SentOnBehalfOfName = "# " & itemContact_temp.FullName
End If
Else 'sender类型不是addressEntry时,意味着联系人中没有保存该发件人
Write #1, "666666666666", TypeName(myItem.sender)
End If
End If
myItem.Save
End Function
Sub mail_rename_sender_batch(ByVal num As Integer)
Dim oInbox As Outlook.Folder
Dim myItem As Outlook.MailItem
Dim myItems As Outlook.Items
Dim tmpCount As Integer
Open "G:TEMPoutlook.txt" For Output As #1
Write #1, "Hello World", 234 ' 写入以逗号隔开的数据。
Write #1, '写入空白行。
Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set myItems = oInbox.Items
myItems.Sort "[SentOn]", True
tmpCount = myItems.Count
If (num > 0) And (num < tmpCount) Then
tmpCount = num
End If
'遍历所有邮件
For i = 1 To tmpCount 'oInbox.Items.Count
'If TypeName(oInbox.Items(i)) = "MailItem" Then
'Set myItem = oInbox.Items(i)
If TypeName(myItems(i)) = "MailItem" Then
Set myItem = myItems(i)
temp = mail_rename_sender(myItem, True)
End If
Next
Close #1 ' 关闭文件。
End Sub
函数2
update_folder是宏名(第一次折腾office中的vb,没搞懂概念,word制作表格教程基础入门,感觉sub xxx类似main函数,算是程序的主入口)点击运行宏就会从这里开始,函数中内容是获取到收件箱,并遍历收件箱中所有电子邮件(还有些会议通知神马的先不管),word教程零基础教程,每封邮件调用updatesendername函数更新发件人名称。
Sub update_folder()
Dim myc As common
Set myc = New common
myc.mail_rename_sender_batch (-1)
End Sub
Private Sub Application_BeforeFolderSharingDialog(ByVal FolderToShare As MAPIFolder, Cancel As Boolean)
End Sub
上一篇:word变成ppt制作教程:outlook通过联系人搜索不到邮件 下一篇:word制作表格教程基础入门:OutLook 编程
郑重声明:本文版权归原作者所有,转载文章仅为传播更多信息之目的,如作者信息标记有误,请第一时间联系我们修改或删除,多谢。