使用powershell或VBA编辑扩展文件属性

Question

有没有办法使用powershell编辑/更改文件的扩展文件属性？特别是，我想更改从outlook导出的.msg文件的扩展文件属性。我在网上看到了一个程序(专有代码(，它保存了一个具有扩展文件属性的.msg文件，以便在文件资源管理器中对其进行排序。在.msg上启用的扩展属性是有用的信息，如接收日期、发件人等。

我一辈子都找不到在VBA或powershell中实现这一点的简单方法，我想知道是否有人有任何想法或解决方案。目前，我已经创建了一个宏，它只需将信息保存在文件名中，但将其放在扩展文件属性中会有用得多。

最让我沮丧的是，有人显然做了这件事，而我不知道是怎么做的。我本以为这会很简单。唉。

编辑：请查看我当前的代码

Public Sub SaveMessageAsMsg()
Dim xMail As Outlook.MailItem
Dim xObjItem As Object
Dim xPath As String
Dim xDtDate As Date
Dim xName, xFileName As String
On Error Resume Next
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.BrowseForFolder(0, "Select a folder:", 0, "C:Users" & Environ("UserName") & "ANON VARIABLE")
If Not TypeName(xFolder) = "Nothing" Then
Set xFolderItem = xFolder.self
xFileName = xFolderItem.Path & ""
Else
xFileName = ""
Exit Sub
End If
For Each xObjItem In Outlook.ActiveExplorer.Selection
If xObjItem.Class = olMail Then
Set xMail = xObjItem
SenderName = xMail.SenderName
xName = xMail.Subject
xDtDate = xMail.ReceivedTime
xName = Replace(Format(xDtDate, "yyyy-mm-dd ", vbUseSystemDayOfWeek, _
vbUseSystem) & " @ " & Format(xDtDate, "hh:mm:ss", _
vbUseSystemDayOfWeek, vbUseSystem) & " - " & SenderName & " - " & xName & ".msg", ":", ".")
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Pattern = "[\/*?""<>|]"
.Global = True
ValidName = .Replace(xName, "")
End With       
xPath = xFileName + ValidName
xMail.SaveAs xPath, olMSG
End If
Next
End Sub

Answer 1

在VBA或Outlook对象模型中无法轻松做到这一点：必须在MSG文件使用的OLE存储级别上设置这些额外属性。

如果使用Redemption(我是它的作者(是一个选项，它会公开olMsgWithSummary格式(类似于OOM中的olMsg和olMsgUnicode(，可以满足您的需要。下面的脚本保存当前选择的Outlook消息：

set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set oMsg = Application.ActiveExplorer.Selection(1)
set rMsg = Session.GetRDOObjectFromOutlookObject(oMsg)
rMsg.SaveAs "c:tempExtraProps.msg", 1035 '1035 is olMsgWithSummary

你上面的脚本想要以下内容(在我的脑海中(：

Public Sub SaveMessageAsMsg()
Dim xMail As Outlook.MailItem
Dim xObjItem As Object
Dim xPath As String
Dim xDtDate As Date
Dim rSession As Object
Dim rSession As Object
Dim xName, xFileName As String
On Error Resume Next
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.BrowseForFolder(0, "Select a folder:", 0, "C:Users" & Environ("UserName") & "ANON VARIABLE")
If Not TypeName(xFolder) = "Nothing" Then
Set xFolderItem = xFolder.self
xFileName = xFolderItem.Path & ""
Else
xFileName = ""
Exit Sub
End If
set rSession = CreateObject("Redemption.RDOSession")
rSession.MAPIOBJECT = Outlook.Session.MAPIOBJECT
For Each xObjItem In Outlook.ActiveExplorer.Selection
If xObjItem.Class = olMail Then
Set xMail = xObjItem
SenderName = xMail.SenderName
xName = xMail.Subject
xDtDate = xMail.ReceivedTime
xName = Replace(Format(xDtDate, "yyyy-mm-dd ", vbUseSystemDayOfWeek, _
vbUseSystem) & " @ " & Format(xDtDate, "hh:mm:ss", _
vbUseSystemDayOfWeek, vbUseSystem) & " - " & SenderName & " - " & xName & ".msg", ":", ".")
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Pattern = "[\/*?""<>|]"
.Global = True
ValidName = .Replace(xName, "")
End With       
xPath = xFileName + ValidName
set rMsg = rSession.GetRDOObjectFromOutlookObject(xMail)
rMsg.SaveAs xPath, 1035
End If
Next
End Sub