Блог

Я могу перемещать электронные письма в свою файловую систему. Возможно ли сделать обратное? Это то, что я пробовал:

 Sub GetMSG()
Dim StrFolder As String
StrFolder = "G:CP-PurchasingCompleted Projects"
ListFilesInFolder StrFolder, True 'True includes subfolders, false check only this folder
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim FileItem As Scripting.File
Dim strFile, strFileType
Dim MyMsg As MailItem
Dim FolderPick As Folder

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
Set FolderPick = Application.GetNamespace("MAPI").PickFolder
For Each FileItem In SourceFolder.Files
    strFile = FileItem.Name
    ' This code looks at the last 4 characters in a filename
    strFileType = LCase$(Right$(strFile, 4))
    If strFileType = ".msg" Then
        Debug.Print FileItem.Path
        Set MyMsg = Application.CreateItemFromTemplate(FileItem.Path)
        MyMsg.SaveAs (FolderPick)'This does not error, but also does not seem to work
        MyMsg.Move (FolderPick)'This errors
        Set objAttachments = Nothing
        Set MyMsg = Nothing
    End If
Next FileItem
If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.SubFolders
        ListFilesInFolder SubFolder.Path, True
    Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub
 

При включении MyMsg.SaveAs (FolderPick) я не получаю сообщения об ошибке, но оно также не сохраняет сообщение об ошибке в указанной папке.

MyMsg.Move (FolderPick) ошибки с

ошибка времени выполнения 424 «Требуется объект».

Для дальнейшей обработки после перемещения вам нужен другой объект, поскольку ссылка на myMsg теряется.

 Set myCopiedMsg = myMsg.Move(folderPick)
Debug.Print myCopiedMsg.Parent.FolderPath
 

В вашем коде только для перемещения:

 ' no brackets
myMsg.Move folderPick