R
Rolf Barbakken
I have scripted saving MSG-files and attachments from Outlook. This works
well on items created and received in Outlook.
But items imported from a PST-file exported from Exchange 2000 seems to be
"invisible" to the code, so to speak.
Here is what I got:
-----------------------
Sub AttachCreateFolder(s As String)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(s)
End Sub
Public Sub InboxSaveEmail()
'On Error Resume Next
Dim objApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objMAPIFolder As Outlook.MAPIFolder
Dim objMailItem As Outlook.MailItem
Dim myattachments As Outlook.Attachments
Dim objThefolder As Outlook.MAPIFolder
Dim lngAttachments As Long
Dim strPath As String
Dim strSavePath As String
Dim strSubject As String
strPath = "d:\midl\e\"
Set objApp = New Outlook.Application
Set objNameSpace = objApp.GetNamespace(Type:="MAPI")
Set objMAPIFolder = _
objNameSpace.GetDefaultFolder(FolderType:=olFolderInbox)
Set objThefolder = objApp.ActiveExplorer.CurrentFolder
MsgBox objThefolder.Name & ":" & vbCrLf & objThefolder.Items.Count & "
items of type " & objThefolder.Items.Class
For Each objMailItem In objThefolder.Items
strSavePath = "\" & objMailItem.EntryID & "\"
AttachCreateFolder (strPath & strSavePath)
If objMailItem.Attachments.Count > 0 Then
Set myattachments = objMailItem.Attachments
For lngAttachments = 1 To objMailItem.Attachments.Count
myattachments.Item(lngAttachments).SaveAsFile strPath &
strSavePath & myattachments.Item(lngAttachments).FileName
'myattachments.Remove (lngAttachments)
Next
End If
objMailItem.SaveAs strPath & strSavePath &
Replace(objMailItem.Subject, ":", " ") & ".msg", olMSG
Next objMailItem
End Sub
-----------------------
The "objThefolder.Items.Count"-line reports correctly 480 items, but the
next line "For Each objMailItem In objThefolder.Items" stops everything with
an errormsg of "Runtime error '13': Type mismatch".
What is wrong here? How can I save messages from PST-files exported from
Exchange?
Any help appreciated. Thanks.
well on items created and received in Outlook.
But items imported from a PST-file exported from Exchange 2000 seems to be
"invisible" to the code, so to speak.
Here is what I got:
-----------------------
Sub AttachCreateFolder(s As String)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(s)
End Sub
Public Sub InboxSaveEmail()
'On Error Resume Next
Dim objApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objMAPIFolder As Outlook.MAPIFolder
Dim objMailItem As Outlook.MailItem
Dim myattachments As Outlook.Attachments
Dim objThefolder As Outlook.MAPIFolder
Dim lngAttachments As Long
Dim strPath As String
Dim strSavePath As String
Dim strSubject As String
strPath = "d:\midl\e\"
Set objApp = New Outlook.Application
Set objNameSpace = objApp.GetNamespace(Type:="MAPI")
Set objMAPIFolder = _
objNameSpace.GetDefaultFolder(FolderType:=olFolderInbox)
Set objThefolder = objApp.ActiveExplorer.CurrentFolder
MsgBox objThefolder.Name & ":" & vbCrLf & objThefolder.Items.Count & "
items of type " & objThefolder.Items.Class
For Each objMailItem In objThefolder.Items
strSavePath = "\" & objMailItem.EntryID & "\"
AttachCreateFolder (strPath & strSavePath)
If objMailItem.Attachments.Count > 0 Then
Set myattachments = objMailItem.Attachments
For lngAttachments = 1 To objMailItem.Attachments.Count
myattachments.Item(lngAttachments).SaveAsFile strPath &
strSavePath & myattachments.Item(lngAttachments).FileName
'myattachments.Remove (lngAttachments)
Next
End If
objMailItem.SaveAs strPath & strSavePath &
Replace(objMailItem.Subject, ":", " ") & ".msg", olMSG
Next objMailItem
End Sub
-----------------------
The "objThefolder.Items.Count"-line reports correctly 480 items, but the
next line "For Each objMailItem In objThefolder.Items" stops everything with
an errormsg of "Runtime error '13': Type mismatch".
What is wrong here? How can I save messages from PST-files exported from
Exchange?
Any help appreciated. Thanks.