VBS to move mail from Exchange Mailbox's Inbox to a Public Folder

[A***@googlemail.com]

I would like VB scripts to move and copy an email received in any
user's Inbox to a specific sub-folder of the Public Folders, ie:

Mailbox - Bob Jones>Inbox -- move to --> Public Folders>Public
Folders>GFI Antispam Folders>This is spam email

The closest I've come to a script that works is the following, which
moves mail from the Inbox to a sub-folder of the Inbox (in this
instance Keep).

==START==
Sub MoveSelectedMessagesToFolder()

On Error Resume Next





Dim objFolder As Outlook.MAPIFolder, objInbox As
Outlook.MAPIFolder

Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem





Set objNS = Application.GetNamespace("MAPI")

Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

Set objFolder = objInbox.Folders("Keep")











'Assume this is a mail folder


If objFolder Is Nothing Then

MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation,
"INVALID FOLDER"

End If





If Application.ActiveExplorer.Selection.Count = 0 Then

'Require that this procedure be called only when a message is
selected

Exit Sub

End If





For Each objItem In Application.ActiveExplorer.Selection

If objFolder.DefaultItemType = olMailItem Then

If objItem.Class = olMail Then

objItem.Move objFolder

End If

End If

Next








Set objItem = Nothing

Set objFolder = Nothing

Set objInbox = Nothing

Set objNS = Nothing

End Sub

==END==

[Don Tweedie]

Hi,

I am currently working on a project to move vaulted stubs from a public
folder to a mailbox. The catch is that I need to create the same folder name
prior to move.
Since this is the first time I have done a scripted move, I am looking for
any advice or assistance I can get with this.

We're you able to get this to work?

thanks in advance for your time.

Don

Post by A***@googlemail.com
I would like VB scripts to move and copy an email received in any
Mailbox - Bob Jones>Inbox -- move to --> Public Folders>Public
Folders>GFI Antispam Folders>This is spam email
The closest I've come to a script that works is the following, which
moves mail from the Inbox to a sub-folder of the Inbox (in this
instance Keep).
==START==
Sub MoveSelectedMessagesToFolder()
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As
Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Folders("Keep")
'Assume this is a mail folder
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation,
"INVALID FOLDER"
End If
If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is
selected
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
End If
End If
Next
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub
==END==