Read email and move using redemption

  • Thread starter Thread starter Joyce Shelton via OfficeKB.com
  • Start date Start date
J

Joyce Shelton via OfficeKB.com

Hi All,

What is the simplest way to move an email item, after it has been read to
another folder? I know the name of the destination folder. I have tried
several syntax and am at a lost.

I tried the following code to get an idea and got an error:
"Error 13 (Type mismatch) in procedure btnGo_Click of Form Form1"

What am I doing wrong?

Here is the code I used from this web site:
VERSION 5.00
Begin VB.Form frmMoveto
Caption = "Form1"
ClientHeight = 2715
ClientLeft = 60
ClientTop = 345
ClientWidth = 5400
LinkTopic = "Form1"
ScaleHeight = 2715
ScaleWidth = 5400
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton btnGo
Caption = "Go"
Height = 375
Left = 2160
TabIndex = 7
Top = 2100
Width = 1035
End
Begin VB.TextBox txtDstFolder
Height = 315
Left = 1560
Locked = -1 'True
TabIndex = 4
Top = 1140
Width = 2535
End
Begin VB.CommandButton btnDstFolderBrowse
Caption = "Browse..."
Height = 375
Left = 4200
TabIndex = 3
Top = 1140
Width = 1035
End
Begin VB.CommandButton btnSrcFolderBrowse
Caption = "Browse..."
Height = 375
Left = 4200
TabIndex = 1
Top = 600
Width = 1035
End
Begin VB.TextBox txtSrcFolder
Height = 315
Left = 1560
Locked = -1 'True
TabIndex = 0
Top = 600
Width = 2535
End
Begin VB.Label Label3
Caption = "Move all Read mail messages from source folder
to destination folder"
Height = 315
Left = 180
TabIndex = 6
Top = 120
Width = 5055
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "Destination Folder:"
Height = 315
Left = 120
TabIndex = 5
Top = 1200
Width = 1395
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Source Folder:"
Height = 315
Left = 120
TabIndex = 2
Top = 660
Width = 1395
End
End
Attribute VB_Name = "frmMoveto"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private objApp As Outlook.Application
Private objNS As Outlook.NameSpace
Private strSrcEntryId As String
Private strSrcStoreId As String
Private strDstEntryId As String
Private strDstStoreId As String

Private Sub btnGo_Click()

Dim item As Outlook.MailItem
Dim olSrcFolder As Outlook.MAPIFolder
Dim ReadItems As Items

On Error GoTo btnGo_Click_Error

Set olSrcFolder = objNS.GetFolderFromID(strSrcEntryId, strSrcStoreId)
Set ReadItems = olSrcFolder.Items
Set item = ReadItems.Find("[Unread] = false")

Do While Not (item Is Nothing)

item.Move objNS.GetFolderFromID(strDstEntryId, strDstStoreId)
Set item = ReadItems.FindNext

Loop


Set item = Nothing
Set ReadItems = Nothing
Set olSrcFolder = Nothing

On Error GoTo 0
Exit Sub

btnGo_Click_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
btnGo_Click of Form Form1"

End Sub

Private Sub btnSrcFolderBrowse_Click()
On Error Resume Next

Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.PickFolder
If Not IsNull(olFolder) Then
txtSrcFolder.Text = olFolder.Name
strSrcEntryId = olFolder.EntryID
strSrcStoreId = olFolder.StoreID
End If
Set olFolder = Nothing

End Sub

Private Sub btnDstFolderBrowse_Click()
On Error Resume Next

Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.PickFolder
If Not IsNull(olFolder) Then
txtDstFolder.Text = olFolder.Name
strDstEntryId = olFolder.EntryID
strDstStoreId = olFolder.StoreID
End If
Set olFolder = Nothing
End Sub

Private Sub Form_Load()
Set objApp = CreateObject("Outlook.application")
Set objNS = objApp.GetNamespace("MAPI")
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set objApp = Nothing
Set objNS = Nothing
End Sub


Please help me as soon as you can.

Joyce
 
Hello Joyce,

1. after GetNameSpace("MAPI") - you should do an objNS.Logon.
2. In the Unread Object must not be a mailitem.
-> Use an Object, Test if it's an Mailitem or Restrict Items to MessageClass
of "IPM.Note"

the Problem could be a Item thats not a Mailitem.

----->>

Option Explicit

Private objApp As Outlook.Application
Private objNS As Outlook.NameSpace

Private objSrcFolder As Outlook.MAPIFolder
Private objDstFolder As Outlook.MAPIFolder

Private Sub btnGo_Click()

Dim item As Outlook.MailItem
Dim ReadItems As Items

On Error GoTo btnGo_Click_Error

' Maybe restrict the Items to Unread and MessageClass
Set ReadItems = objSrcFolder.Items.Restrict("[Unread] = true AND
[MessageClass] = 'IPM.Note'")

' Set item = ReadItems.Find("[Unread] = false")
For Each item In ReadItems

item.Move objDstFolder
DoEvents

Next

Set item = Nothing
Set ReadItems = Nothing

On Error GoTo 0
Exit Sub

btnGo_Click_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure"

End Sub

Private Sub btnSrcFolderBrowse_Click()
On Error Resume Next

' Why don't use Folder that you already get from PickFolder ?
Set objSrcFolder = objNS.PickFolder

End Sub

Private Sub btnDstFolderBrowse_Click()
On Error Resume Next

'Same for DestinationFolder
Set objDstFolder = objNS.PickFolder

End Sub

Private Sub Form_Load()
Set objApp = CreateObject("Outlook.application")
Set objNS = objApp.GetNamespace("MAPI")

'Logon to Session
objNS.Logon , , False, False
End Sub

Private Sub Form_Unload(Cancel As Integer)

' Release Objects
Set objDstFolder = Nothing
Set objSrcFolder = Nothing

'Logoff
objNS.Logoff

Set objNS = Nothing
Set objApp = Nothing
End Sub

------------------

Hope that helps,
Greets, Helmut Obertanner



Joyce Shelton via OfficeKB.com said:
Hi All,

What is the simplest way to move an email item, after it has been read to
another folder? I know the name of the destination folder. I have tried
several syntax and am at a lost.

I tried the following code to get an idea and got an error:
"Error 13 (Type mismatch) in procedure btnGo_Click of Form Form1"

What am I doing wrong?

Here is the code I used from this web site:
VERSION 5.00
Begin VB.Form frmMoveto
Caption = "Form1"
ClientHeight = 2715
ClientLeft = 60
ClientTop = 345
ClientWidth = 5400
LinkTopic = "Form1"
ScaleHeight = 2715
ScaleWidth = 5400
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton btnGo
Caption = "Go"
Height = 375
Left = 2160
TabIndex = 7
Top = 2100
Width = 1035
End
Begin VB.TextBox txtDstFolder
Height = 315
Left = 1560
Locked = -1 'True
TabIndex = 4
Top = 1140
Width = 2535
End
Begin VB.CommandButton btnDstFolderBrowse
Caption = "Browse..."
Height = 375
Left = 4200
TabIndex = 3
Top = 1140
Width = 1035
End
Begin VB.CommandButton btnSrcFolderBrowse
Caption = "Browse..."
Height = 375
Left = 4200
TabIndex = 1
Top = 600
Width = 1035
End
Begin VB.TextBox txtSrcFolder
Height = 315
Left = 1560
Locked = -1 'True
TabIndex = 0
Top = 600
Width = 2535
End
Begin VB.Label Label3
Caption = "Move all Read mail messages from source folder
to destination folder"
Height = 315
Left = 180
TabIndex = 6
Top = 120
Width = 5055
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "Destination Folder:"
Height = 315
Left = 120
TabIndex = 5
Top = 1200
Width = 1395
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Source Folder:"
Height = 315
Left = 120
TabIndex = 2
Top = 660
Width = 1395
End
End
Attribute VB_Name = "frmMoveto"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private objApp As Outlook.Application
Private objNS As Outlook.NameSpace
Private strSrcEntryId As String
Private strSrcStoreId As String
Private strDstEntryId As String
Private strDstStoreId As String

Private Sub btnGo_Click()

Dim item As Outlook.MailItem
Dim olSrcFolder As Outlook.MAPIFolder
Dim ReadItems As Items

On Error GoTo btnGo_Click_Error

Set olSrcFolder = objNS.GetFolderFromID(strSrcEntryId, strSrcStoreId)
Set ReadItems = olSrcFolder.Items
Set item = ReadItems.Find("[Unread] = false")

Do While Not (item Is Nothing)

item.Move objNS.GetFolderFromID(strDstEntryId, strDstStoreId)
Set item = ReadItems.FindNext

Loop


Set item = Nothing
Set ReadItems = Nothing
Set olSrcFolder = Nothing

On Error GoTo 0
Exit Sub

btnGo_Click_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
btnGo_Click of Form Form1"

End Sub

Private Sub btnSrcFolderBrowse_Click()
On Error Resume Next

Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.PickFolder
If Not IsNull(olFolder) Then
txtSrcFolder.Text = olFolder.Name
strSrcEntryId = olFolder.EntryID
strSrcStoreId = olFolder.StoreID
End If
Set olFolder = Nothing

End Sub

Private Sub btnDstFolderBrowse_Click()
On Error Resume Next

Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.PickFolder
If Not IsNull(olFolder) Then
txtDstFolder.Text = olFolder.Name
strDstEntryId = olFolder.EntryID
strDstStoreId = olFolder.StoreID
End If
Set olFolder = Nothing
End Sub

Private Sub Form_Load()
Set objApp = CreateObject("Outlook.application")
Set objNS = objApp.GetNamespace("MAPI")
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set objApp = Nothing
Set objNS = Nothing
End Sub


Please help me as soon as you can.

Joyce
Click to expand...
 
Back
Top