![]() |
If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Search this Thread | Display Modes |
#1
|
|||
|
|||
![]()
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? |
Ads |
#2
|
|||
|
|||
![]()
Handle all errors and release all your objects is a general rule. That's
about all anyone can say from the information you provided. -- Ken Slovak [MVP - Outlook] http://www.slovaktech.com Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003 Reminder Manager, Extended Reminders, Attachment Options http://www.slovaktech.com/products.htm wrote in message oups.com... 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? |
#3
|
|||
|
|||
![]()
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 below ![]() 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] wrote: Handle all errors and release all your objects is a general rule. That's about all anyone can say from the information you provided. -- Ken Slovak [MVP - Outlook] http://www.slovaktech.com Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003 Reminder Manager, Extended Reminders, Attachment Options http://www.slovaktech.com/products.htm wrote in message oups.com... 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? |
#4
|
|||
|
|||
![]()
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? -- Ken Slovak [MVP - Outlook] http://www.slovaktech.com Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003 Reminder Manager, Extended Reminders, Attachment Options http://www.slovaktech.com/products.htm "TheSharpOne" wrote in message ups.com... 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 below ![]() 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 -------------------------- |
#5
|
|||
|
|||
![]()
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] wrote: 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? -- Ken Slovak [MVP - Outlook] http://www.slovaktech.com Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003 Reminder Manager, Extended Reminders, Attachment Options http://www.slovaktech.com/products.htm "TheSharpOne" wrote in message ups.com... 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 below ![]() 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 -------------------------- |
#6
|
|||
|
|||
![]()
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. -- Ken Slovak [MVP - Outlook] http://www.slovaktech.com Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003 Reminder Manager, Extended Reminders, Attachment Options http://www.slovaktech.com/products.htm "TheSharpOne" wrote in message ups.com... 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Outlook won't clear outbox and move to sent mail. Mail is sent. | Pasta guy | Outlook - General Queries | 1 | July 6th 06 09:59 PM |
How can I move Outlook contacts to Apple's Mail? | greg | Outlook - Using Contacts | 1 | May 18th 06 12:53 PM |
VBA to move outbound email and mark as read? | [email protected] | Outlook and VBA | 11 | May 2nd 06 04:07 PM |
Here's a challenge - VBA regarding mail | Stealth1 | Outlook and VBA | 3 | April 26th 06 06:03 PM |
Using VBA code to move current message to a folder | Dean | Outlook and VBA | 4 | February 26th 06 02:46 AM |