El siguiente código permite mover los mensajes de nuestra bandeja de entrada a una carpeta de nombre “inbox” en un fichero local pst de nombre ” archivado”.
————————————————————————————–
Sub archivado()
‘ Mover mensajes seleccionados a la carpeta “inbox” en “Personal Folder”
‘ alt+1
On Error Resume Next
Dim oApp As Outlook.Application
Dim objFolder As Outlook.MAPIFolder
Set oApp = New Outlook.Application
Set objFolder = oApp.GetNamespace(“MAPI”).Folders(“archivado”).Folders(“inbox”)
Dim oEmail As Outlook.MailItem
‘Assume this is a mail folder
If objFolder Is Nothing Then
MsgBox “Esta carpeta no existe !!!!”, 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
