outlook vba to move mail

[sharp131]

I've written some VBA in outlook that takes the place of the rules
wizard (i'v hit the 32K limit as I have loaded of rules). The VBA work

fine, but after its run when I try to close outlook it just hangs.

Any ideas what I need to add to the vba to ensure that outlook will
close properly after its been executed?

 

[Ken Slovak - [MVP - Outlook]]

Handle all errors and release all your objects is a general rule. That's
about all anyone can say from the information you provided.

 

[TheSharpOne]

Thanks for this. I think that I have handled errors and released all
object and it still seems to hang. The code I have written is
belowthe code is from a user form which is my progress bar). I then
just have a very simple Userform1.show which kicks the main code off.

Thanks

-----------------------
Private Sub UserForm_Activate()
On Error GoTo ErrOutput

Dim Myxls As Object
Dim myNS As NameSpace
Dim myInbox As MAPIFolder
Dim msg As Object
Dim ToBeMoved() As MailItem
Dim NumberToMove As Integer
Dim idx As Integer

ErrorFlag = 0

' Resize the UserForm
Me.Width = 240
Me.Height = 60

' Resize the label
Me.Label1.Height = 25
Me.Label1.Caption = ""
Me.Label1.Width = 1
Me.Label1.BackColor = wdColorBlue

Set myNS = GetNamespace("MAPI")

Set myInbox = Nothing
For Each f1 In myNS.Folders
If f1 = "Mailbox - Info Centre" Then
For Each f2 In f1.Folders
If f2 = "Inbox" Then
Set myInbox = f2
End If
Next
End If
Next

Set f1 = Nothing
Set f2 = Nothing

Set Myxls = CreateObject("Excel.application")
'Myxls.Application.Visible = True
Myxls.Application.Workbooks.Open
FileName:="U:\SASXV001Data\SasData\Live\InfoCentre Outlook Rules.xls"

TotalRules = Myxls.Application.Cells(1, 5)
MaxWidth = 210
pc = MaxWidth / TotalRules

i = Empty
For i = 2 To 10000
NewWidth = pc * i
Me.Label1.Width = NewWidth
Me.Repaint
If Myxls.Application.Cells(i, 1) <> "" Then
Message = Myxls.Application.Cells(i, 1)
FolderVar = Myxls.Application.Cells(i, 2)
Call Process(myInbox, NumberToMove, ToBeMoved, Message, myNS,
FolderVar, Dest, f1, f2, f3, f4, msg)
End If
If Myxls.Application.Cells(i, 1) = "" Then i = 99999
Next i

Myxls.Application.Quit

Unload Me

GoTo Final

ErrOutput:
Unload Me
Myxls.Application.Quit
ErrorFlag = 1
Text = "Processing Failed at row " & i & " of the Excel Spreadsheet.
The subject of the email to be moved was: '" & Message & "'.
Processing will now terminate without completing"
var = MsgBox(Text, vbCritical, "Info Centre VBA Rules")

Final:
'Final Tidy
Set myInbox = Nothing
Set myNS = Nothing
Set Myxls = Nothing

If ErrorFlag = 0 Then var = MsgBox("InfoCentre VBA Rules Processing
Complete", vbInformation, "Info Centre VBA Rules")

End Sub

Public Sub Process(myInbox, NumberToMove, ToBeMoved, Message, myNS,
FolderVar, Dest, f1, f2, f3, f4, msg)

Call Scan(myInbox, NumberToMove, ToBeMoved, Message)
Call FindFolder(myNS, FolderVar, Dest)
Call MoveItem(NumberToMove, ToBeMoved, Dest)
Call Cleanup(myNS, myInbox, f1, f2, f3, f4, Dest, msg)

End Sub

Public Sub Cleanup(myNS, myInbox, f1, f2, f3, f4, Dest, msg)

Set f1 = Nothing
Set f2 = Nothing
Set f3 = Nothing
Set f4 = Nothing
Set Dest = Nothing
Set msg = Nothing

End Sub

Public Sub Scan(myInbox, NumberToMove, ToBeMoved, Message)
'Scan For Messages
NumberToMove = 0
For Each msg In myInbox.Items
'Process only mail messages.
If TypeOf msg Is MailItem Then
If msg.Subject Like Message And msg.SenderName = "SQL Mail
Account" Then
NumberToMove = NumberToMove + 1
ReDim Preserve ToBeMoved(NumberToMove)
Set ToBeMoved(NumberToMove) = msg
End If
End If
Next

End Sub

Public Sub FindFolder(myNS, FolderVar, Dest)

Set Dest = Nothing
For Each f1 In myNS.Folders
If f1 = "Mailbox - Info Centre" Then
For Each f2 In f1.Folders
If f2 = "Inbox" Then
For Each f3 In f2.Folders
If f3 = FolderVar Then
Set Dest = f3
End If
For Each f4 In f3.Folders
If f4 = FolderVar Then
Set Dest = f4
End If
Next
Next
End If
Next
End If
Next

End Sub

Public Sub MoveItem(NumberToMove, ToBeMoved, Dest)

If NumberToMove > 0 Then
For idx = 1 To NumberToMove
ToBeMoved(idx).Move Dest
Next
End If

End Sub

 

[Ken Slovak - [MVP - Outlook]]

Don't pass local object variables to another procedure to release them. Why
are you getting the Inbox by using that code? Why not with
NameSpace.GetDefaultFolder(olFolderInbox)?

So, does your code ever hit the error handler?

 

[TheSharpOne]

I'm using the code to get the inbox as the inbox I want it not my own,
but a departmental inbox that we all have access to, and I want to be
able to run the vba from my own mailbox rather than having to log into
the specified mailbox to run the vba.
The code only hits the error handler when the destination folder
doesn't exist (either have not created it or typed its name wrong in
the excel spreadsheet)

I'm only a self taught VBA chap so in terms of not passing local object
variable to another procedure what would be the best way around this ?

Thanks for your help

 

[Ken Slovak - [MVP - Outlook]]

If you have access to that Inbox you probably should use the
GetSharedDefaultFolder method of the NameSpace object.

I would just set the objects equal to Nothing right at the end of the
procedure that declares them. Global objects should be released in your
shutdown code and module level objects should be released when the form or
class is terminated.