目前使用 VB 宏将电子邮件文件夹拉到 Windows 文件系统,但无法拉出存储在 Exchange 服务器上的文件夹,这可能吗?使用下面的 VB 脚本
' SET STARTING FOLDER IN FODLER CHOOSER AS USERS [P DRIVE]
Const STARTING_FOLDER = "P:"
Dim objFSO As Object
' [COPY] THE OUTLOOK FOLDER
Sub CopyOutlookFolderToFileSystem()
ExportController "Copy"
End Sub
' [MOVE] THE OUTLOOK FOLDER
Sub MoveOutlookFolderToFileSystem()
ExportController "Move"
End Sub
' [USER] SELECTION OF FOLDER TO SAVE MESSAGES INTO ON SYSTEM
Sub ExportController(strAction As String)
Dim olkFld As Outlook.MAPIFolder, strPath As String
strPath = SelectFolder(STARTING_FOLDER)
If strPath = "" Then
MsgBox "No Folder selected! Export cancelled.", vbInformation + vbOKOnly, "Export Outlook Folder"
Else
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set olkFld = Application.ActiveExplorer.CurrentFolder
ExportOutlookFolder olkFld, strPath
If LCase(strAction) = "move" Then olkFld.Delete
End If
Set olkFld = Nothing
Set objFSO = Nothing
End Sub
' FOR [ALL] MESSAGES IN THE FOLDER, EXPORT [ALL] MESSAGES
Sub ExportOutlookFolder(ByVal olkFld As Outlook.MAPIFolder, strStartingPath As String)
Dim olkSub As Outlook.MAPIFolder, olkItm As Object, strPath As String, strMyPath As String, strSubejct As String, intCount As Integer
strPath = strStartingPath & "\" & olkFld.Name
objFSO.CreateFolder strPath
For Each olkItm In olkFld.Items
strSubject = "[From] " & olkItm.SenderName & " [Subject] " & RemoveIllegalCharacters(olkItm.Subject)
strFilename = strSubject & ".msg"
intCount = 0
Do While True
strMyPath = strPath & "\" & strFilename
If objFSO.FileExists(strMyPath) Then
intCount = intCount + 1
strFilename = strSubject & " (" & intCount & ").msg"
Else
Exit Do
End If
Loop
olkItm.SaveAs strMyPath, olMSG
ChangeTimeStamp strMyPath, olkItm.ReceivedTime
Next
For Each olkSub In olkFld.Folders
ExportOutlookFolder olkSub, strPath
Next
Set olkFld = Nothing
Set olkItm = Nothing
End Sub
Function SelectFolder(varStartingFolder As Variant) As String
' STANDARD ERROR HANDLING
Dim objFolder As Object, objShell As Object
On Error Resume Next
' CREATE A DIALOG OBJECT FOR FOLDER SELECTION & RETURN THE FOLDER [PATH]
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Select the System folder you want to export to ...", 0, varStartingFolder)
If TypeName(objFolder) <> "Nothing" Then SelectFolder = objFolder.self.Path
' STANDARD ERROR HANDLING
Set objFolder = Nothing
Set objShell = Nothing
On Error GoTo 0
End Function
Function RemoveIllegalCharacters(strValue As String) As String
' REMOVE [ALL CHARACTERS] THAT CANNOT BE CONTAINED IN A FILESYSTEM NAME
RemoveIllegalCharacters = strValue
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "")
End Function
Sub ChangeTimeStamp(strFile As String, datStamp As Date)
' SAVE IN THE FILENAME THE [TIME] AND [DATE] OF THE [ORIGINAL] MESSAGE BEING SENT/RECIEVED
Dim objShell As Object, objFolder As Object, objFolderItem As Object, varPath As Variant, varName As Variant
varName = Mid(strFile, InStrRev(strFile, "\") + 1)
varPath = Mid(strFile, 1, InStrRev(strFile, "\"))
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(varPath)
Set objFolderItem = objFolder.ParseName(varName)
objFolderItem.ModifyDate = CStr(datStamp)
Set objShell = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
End Sub
答案1
由于你没有指定是否必须通过老式的 VB 脚本来完成...我会使用Exchange Web 服务然后通过这种方式将电子邮件导出到文件服务器。这里不需要 Outlook 客户端。但是您需要用 C# 编写一些内容。这里例如:
private static void ExportMIMEEmail(ExchangeService service)
{
Folder inbox = Folder.Bind(service, WellKnownFolderName.Inbox);
ItemView view = new ItemView(1);
view.PropertySet = new PropertySet(BasePropertySet.IdOnly);
// This results in a FindItem call to EWS.
FindItemsResults<Item> results = inbox.FindItems(view);
foreach (var item in results)
{
PropertySet props = new PropertySet(EmailMessageSchema.MimeContent);
// This results in a GetItem call to EWS.
var email = EmailMessage.Bind(service, item.Id, props);
string emlFileName = @"C:\export\email.eml";
string mhtFileName = @"C:\export\email.mht";
// Save as .eml.
using (FileStream fs = new FileStream(emlFileName, FileMode.Create, FileAccess.Write))
{
fs.Write(email.MimeContent.Content, 0, email.MimeContent.Content.Length);
}
// Save as .mht.
using (FileStream fs = new FileStream(mhtFileName, FileMode.Create, FileAccess.Write))
{
fs.Write(email.MimeContent.Content, 0, email.MimeContent.Content.Length);
}
}
}