Macro to move files to Data File

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I save all deleted and sent files to deleted/sent folders in an open 'Data
File' file. I get a lot of email, so do to space, I keep having to manually
move these my deleted/sent files from my Exchange mailbox to my deleted/sent
files folder in my 'Data File'. It would be nice to have a macro that would
do this automatically.

How difficult would it be for someone with no VB experience to learn enough
VB to create a macro to move files from my mailbox (on an Exchange server)
deleted/sent folders to 'Data File' deleted/sent folders?

Or do any of you smart folks have one already? :-)

It's a shame Outlook doesn't have a record macro function like Excel and
Word where you can record the macro while performing the action.

Thanks,
Matt
 
Ordubis said:
I save all deleted and sent files to deleted/sent folders in an open
'Data File' file. I get a lot of email, so do to space, I keep having
to manually move these my deleted/sent files from my Exchange mailbox
to my deleted/sent files folder in my 'Data File'. It would be nice
to have a macro that would do this automatically.

How difficult would it be for someone with no VB experience to learn
enough VB to create a macro to move files from my mailbox (on an
Exchange server) deleted/sent folders to 'Data File' deleted/sent
folders?

Or do any of you smart folks have one already? :-)

It's a shame Outlook doesn't have a record macro function like Excel
and Word where you can record the macro while performing the action.

Thanks,
Matt
Click to expand...

Matt, you can copy this code into "ThisOutlookSession" and add a button
to a toolbar linked with the first sub. The sample can also move items
from subfolders but all items will be moved into *one* folder only.

Option Explicit
Private m_oDestinationFolder As Outlook.MAPIFolder

Public Sub MoveItemsA()
Dim oSourceFld As Outlook.MAPIFolder
Dim oDestFld As Outlook.MAPIFolder
Dim bRecursive As Boolean

Set oSourceFld = Application.Session.PickFolder
If oSourceFld Is Nothing Then
Exit Sub
End If

Set oDestFld = Application.Session.PickFolder
If oDestFld Is Nothing Then
Exit Sub
End If

Select Case MsgBox("Move items from subfolders, too?", _
vbYesNoCancel + vbDefaultButton2 + vbQuestion)
Case vbCancel
Exit Sub
Case vbYes
bRecursive = True
End Select

MoveItems oSourceFld, oDestFld, bRecursive
End Sub

Private Sub MoveItems(oSourceFolder As Outlook.MAPIFolder, _
oDestinationFolder As Outlook.MAPIFolder, _
ByVal bRecursive As Boolean _
)
On Error GoTo ERR_HANDLER

Set m_oDestinationFolder = oDestinationFolder

LoopItems oSourceFolder.Items

If bRecursive Then
LoopFolders oSourceFolder.Folders, bRecursive
End If

AUSGANG:
Set m_oDestinationFolder = Nothing
Exit Sub

ERR_HANDLER:
MsgBox Err.Description, vbExclamation
Resume AUSGANG
End Sub

Private Sub LoopFolders(oFolders As Outlook.Folders, _
ByVal bRecursive As Boolean _
)
Dim oFld As Outlook.MAPIFolder

For Each oFld In oFolders
LoopItems oFld.Items
LoopFolders oFld.Folders, bRecursive
Next
End Sub

Private Sub LoopItems(oItems As Outlook.Items)
Dim i As Long

For i = oItems.Count To 1 Step -1
oItems(i).Move m_oDestinationFolder
Next
End Sub
 
Back
Top