W
welch.chris
Hi
I am receiving a "type mismatch" error when trying to move an item
from Sent Items (what I am trying to do is move an item from the
default Sent Items, to the Sent Items in a separate mailbox, which is
configured to open with this one if that makes sense?) I am using
Exchange Server in Outlook 2003.
I've basically done very little VBA for Outlook, so most of this is
taken from examples that I've found online and modified to suit.
I think (having used the VarType function) the GetFolder sub is
returning a string as opposed to a MAPIFolder, but I can't work out
why.. however, if I use the 'Display' function on the folder variable,
the correct folder is displayed, so that could be a red herring.
Many thanks in advance for any help anyone may be able to give!
My code thus far is:
Option Explicit
Dim dest_folder As String
Dim safe_mail_item
Dim ol_app As Outlook.Application
Dim namespace
Dim sent_as_safe
Dim safe_current_user
Dim folder As Outlook.MAPIFolder
Dim folder_root
Dim folder_count
Dim sent_folder
Private WithEvents sent_items As Items
Private Sub Application_Startup()
Set ol_app = CreateObject("Outlook.Application")
Set namespace = ol_app.GetNamespace("MAPI")
Set sent_folder = namespace.GetDefaultFolder(olFolderSentMail)
Set sent_items = sent_folder.Items
Set namespace = Nothing
Set ol_app = Nothing
End Sub
Private Sub sent_items_ItemAdd(ByVal Item As Object)
Dim msg
If Item.Class = olMail Then
dest_folder = "Mailbox - Waterline Limited - Direct Deliveries
\Sent Items"
'Set ol_app = CreateObject("Outlook.Application")
'Set namespace = ol_app.GetNamespace("MAPI")
Set folder = GetFolder(dest_folder)
MsgBox (VarType(folder))
If folder Is Nothing Then
msg = MsgBox("The folder: " + dest_folder + " cannot be
found", 0, "Destination folder not found")
Else
Item.Save
Item.Move (folder)
End If
End If
End Sub
' The following function was blatantly plagiarised! I've not changed
it, however, it appears to return a String though, as opposed to a
MAPIFolder?
Public Function GetFolder(strFolderPath As String) As
Outlook.MAPIFolder
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim objApp As Outlook.Application
Dim objNS As Outlook.namespace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function
I am receiving a "type mismatch" error when trying to move an item
from Sent Items (what I am trying to do is move an item from the
default Sent Items, to the Sent Items in a separate mailbox, which is
configured to open with this one if that makes sense?) I am using
Exchange Server in Outlook 2003.
I've basically done very little VBA for Outlook, so most of this is
taken from examples that I've found online and modified to suit.
I think (having used the VarType function) the GetFolder sub is
returning a string as opposed to a MAPIFolder, but I can't work out
why.. however, if I use the 'Display' function on the folder variable,
the correct folder is displayed, so that could be a red herring.
Many thanks in advance for any help anyone may be able to give!
My code thus far is:
Option Explicit
Dim dest_folder As String
Dim safe_mail_item
Dim ol_app As Outlook.Application
Dim namespace
Dim sent_as_safe
Dim safe_current_user
Dim folder As Outlook.MAPIFolder
Dim folder_root
Dim folder_count
Dim sent_folder
Private WithEvents sent_items As Items
Private Sub Application_Startup()
Set ol_app = CreateObject("Outlook.Application")
Set namespace = ol_app.GetNamespace("MAPI")
Set sent_folder = namespace.GetDefaultFolder(olFolderSentMail)
Set sent_items = sent_folder.Items
Set namespace = Nothing
Set ol_app = Nothing
End Sub
Private Sub sent_items_ItemAdd(ByVal Item As Object)
Dim msg
If Item.Class = olMail Then
dest_folder = "Mailbox - Waterline Limited - Direct Deliveries
\Sent Items"
'Set ol_app = CreateObject("Outlook.Application")
'Set namespace = ol_app.GetNamespace("MAPI")
Set folder = GetFolder(dest_folder)
MsgBox (VarType(folder))
If folder Is Nothing Then
msg = MsgBox("The folder: " + dest_folder + " cannot be
found", 0, "Destination folder not found")
Else
Item.Save
Item.Move (folder)
End If
End If
End Sub
' The following function was blatantly plagiarised! I've not changed
it, however, it appears to return a String though, as opposed to a
MAPIFolder?
Public Function GetFolder(strFolderPath As String) As
Outlook.MAPIFolder
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim objApp As Outlook.Application
Dim objNS As Outlook.namespace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function