I previously asked about getting rules to work on multiple accounts. It was partially answered, however rules do not work on the second account.
When running the script the progress window pops up, but no rules run.
Debug output of the rules lists all the rules for the account. If I manually run the rules, it does work.
Decided to split the macro into two. Running the first macro works for the first account. But the second macro for the second account doesn't work.
My assumption is it is trying to run those rules on the first account, but not succeeding because those rules do not exist.
Sub RunTest_AccountOne()
Dim storeRules As Rules
Dim storeRule As Rule
Dim allStores As Stores
Dim myStore As Store
Dim emailaccount As String
Set allStores = Session.Stores
emailaccount = "example#example.com.au"
For Each myStore In allStores
'On Error Resume Next
'If needed, place just before the expected error.
'Follow closely with On Error GoTo 0 to return to normal error handling.
'Debug.Print myStore.DisplayName & " " & myStore.ExchangeStoreType
Select Case myStore.DisplayName
Case emailaccount
'Debug.Print " ExchangeStoreType matched: " _
& myStore.DisplayName & " " & myStore.ExchangeStoreType
Set storeRules = myStore.GetRules()
For Each storeRule In storeRules
'Below only works if it is the first account added to Outlook.
'storeRule.Execute 'ShowProgress:=False
'Below shows the progress window for rules running, but doesn't apply anything.
storeRule.Execute ShowProgress:=True, Folder:=myStore.GetDefaultFolder(olFolderInbox), RuleExecuteOption:=olRuleExecuteAllMessages
'Below outputs a bunch of "Inbox" messages in the console, which coincides with the amount of rules, as expected.
'Debug.Print myStore.GetDefaultFolder(olFolderInbox)
Next
End Select
Next
End Sub
I have tried with RuleExecuteOption:=olRuleExecuteAllMessages and without.
Related
Outlook Version 2211 (Build 15831.20208 Click-to-Run)
Access Version 2211 (Build 15831.20208 Click-to-Run)
Set olApp = GetObject(, "Outlook.Application")
' Get the Outlook objects we need
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox)
Set olStore = olFolder.Store
Set olRules = olStore.GetRules
lRecordNumberEnd = olRules.Count
For Each olRule In olRules
***** Is there a way to determine if a rule has been classified as in error from the olRule object and possibly what the error is?
If I am processing a rule that moves a message to a specific folder, I will get an error when I try to reference the folder name:
Case olRuleActionMoveToFolder ' Rule action is to move the message to the specified folder."
Set olMoveOrCopyRuleAction = olAction
On Error Resume Next
rs.Fields("Information").Value = " " & " " & olMoveOrCopyRuleAction.Folder
If Err.Number <> 0 Then
If Err.Number = 91 Then
rs.Fields("Information").Value = " " & " " & "***** Folder not defined *****"
Else
rs.Fields("Information").Value = " " & " " & Err.Description
End If
rs.Fields("Status").Value = " **Error**"
End If
On Error GoTo 0
Now if you are in Outlook and click on Rule/Manage Rules and Alerts, Outlook will display a single popup:
One or more rules contain errors. Delete or modify these rules.
So, Outlook has a simple way to determine that at least one enabled rule is in contains an error. If the rule that has an error is disabled, Outlook still highlights it in the list of rules.
So, my question is:
How do I identify that a rule has an error and what the error is without having to process the rule and throw an error?
There is no generic way to do that, but you can do a sanity check on at least the rules that point to a folder, such as copy or move action rule - check Rule.Actions.MoveToFolder / CopyToFolder actions are enabled, try to access MoveOrCopyRuleAction.Folder property and see if it raises an error.
You can use the Rules.Save method do diagnose if anything is wrong with a rules. Saving rules that are incompatible or have improperly defined actions or conditions (such as an empty string for TextRuleCondition.Text or wrong folder used) will return an error.
Rules are not fully exposed in the object model. You can use VBA to create the rules, but not repair them. For example, see Create a Rule to Move Specific Emails to a Folder.
..................................................................................................................................................................
Late-breaking news...
P.P.S. I just read that FileSystem.FileCopy is better than just FileCopy. That's what I'm going to try. But I really would like to know how to use FileCopy inside a loop, meaning, "How do I close files used in FileCopy?" For the big picture made clear, read on.
..................................................................................................................................................................
(Using Windows 10 Pro, Word 365 Pro)
The online Help for FileCopy Src, Dest says that it ... Copies a file from Src to Dest [but] does not work on a currently open file. Both ... files must be closed [by] the Close statement.
But the online help for Close, from link supplied on that page connects to help for Close for the Open statement, which says that it "Closes the file(s) previously opened with the" Open statement, not the FileCopy statement.
So it is that I'm stumped on what to do with this code, which will copy the first code module in the Document to a backup location, but not the second.
Pic#1: Info about what's supposedly going to be copied
Pic#2: Original error message without On Error
(I have no clue why all these blank lines. They're NOT in my Body.)
Please ignore all the OnError stuff for now.
When the second code module should have been copied, execution halted with error "File not found".
Sub BackupModules()
Dim prj As VBProject
Dim comp As VBComponent
Dim code As CodeModule
Set prj = ThisDocument.VBProject
Dim k As Integer, n As Integer
Dim Destination As String, Prefix As String
Prefix = "junk"
k = 0: n = 0
On Error GoTo x
For Each comp In prj.VBComponents
On Error GoTo x
k = k + 1
If comp.Type = vbext_ct_StdModule Then
n = n + 1
Destination = Prefix & n
MsgBox "Copying Standard module " & n & " of " & k & " components encountered: <" & comp.Name & "> to " _
& Destination & "; # lines: " & comp.CodeModule.CountOfLines
On Error GoTo x
FileCopy comp.Name, Destination
MsgBox "Success"
Close
Else
x: If Err.Number <> 0 Then: _
msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description: _
MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext: On Error GoTo 0: Close:
End If
Next
End Sub
Then I began experimenting (a LOT as you can see) with On Error Goto x being placed at various places (one at a time and then all, as shown) and the nasty-looking but syntactically and logically correct line that starts x: If Err... placed inside the Else block.
Pic#3: Error msg after using On Error
(FWIW, I just spotted Normal in the Err.Source part of the error message above. Online help says, "When an unexpected error occurs in your code, the Source property is automatically filled in. For errors in a standard module, Source contains the project name. For errors in a class module, Source contains a name with the project.class form." Indeed, the code is in a Module within the Normal Project.)
Pic#4: Line causing error that On Error did NOT trap
So what's wrong? I've tried everything I can think of. The only help I could find for Close did NOT mention its use with FileCopy. My Close usages caused no error but did Close close both the source and the destination file? Surely not. First use of FileCopy worked, files (probably) not closed, thus second use of FileCopy failed. Docs say using FileCopy on an open file will cause error.
On Error Goto x or to 0 is neither here nor there. That's why I said to ignore them at first.
The question is apparently "How do I close both files mentioned in FileCopy?"
P.S. Per opening blurb, I'm NOT gonna do this.
I suppose I could use Open ... For Input As File#1 and specify the Module's name, if it's readily available to code, and also Open ... For Output As File#2 for the destination, use a For loop to copy the number of lines, if available, and then Close both. But I hope I get a solution to my problem before I try that since SURELY FileCopy should work within a loop (and doesn't because of improper close).
Thanks to #TimWilliams, who tipped me off to Export, my final "Backup all modules" routine is quite simple.
Sub BackupModules()
Dim comp As VBComponent
Dim prj As VBProject: Set prj = ThisDocument.VBProject
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
Dim destPrefix As String: destPrefix = "C:\Users\Dov\Google Drive\Word\Modules\"
Dim destFilePath As String
For Each comp In prj.VBComponents
If comp.Type = vbext_ct_StdModule Then
destFilePath = destPrefix & comp.Name & " " & Year(Now) & " " & Month(Now) & " " & Day(Now)
Debug.Print "Copying Standard module <" & comp.Name & "> to <" & destFilePath & ">"
comp.Export (destFilePath)
Else
Debug.Print "Skipping component # " & k & ", <" & comp.Name & ">, type " & comp.Type
End If
Next
End Sub
I am trying to use VBA to create a folder within Sharepoint at my work. The document is opened from Sharepoint so there should be no credential issues (I would think).
I have tried all of the following and always get Run-time error '76': Path not found
How .Path reads the document's location (having removed the document obviously)
MkDir "https://company.sharepoint.com/directory/directory with spaces"
Without certificate
MkDir "//company.sharepoint.com/directory/directory with spaces"
With backslashes between directories
MkDir "https://company.sharepoint.com\directory\directory with spaces"
With corrected spaces
MkDir "https://company.sharepoint.com/directory/directory%20with%20spaces"
and most combinations of the above.
I noted that it takes much longer for Word to decide it's an invalid path without certificate.
I cannot post the actual paths due to NDA issues, but the above recreation should have all pertinent possible issues within the path. I am not parsing the path from variables or input (though I will later) and they are held within a private sub.
I appreciate any help you can give.
Okay, this took me far longer to complete than I expected. I essentially just grabbed the solution from the link in my first comment link I above and added error handling so that (hopefully) all scenarios have a good exit point and explanation.
Sub SharepointAddFolder()
Dim filePath As String
filePath = "https://web.site.com/SharedDocuments/Folder"
'filePath = Replace(filePath, "https:", "") 'I didn't need these but who knows
'filePath = Replace(filePath, "/", "\")
'filePath = Replace(filePath, " ", "%20")
Dim newFolderName As String
newFolderName = "New Folder"
Dim driveLetter As String
driveLetter = "Z:"
Dim ntwk As Object
Set ntwk = CreateObject("WScript.Network")
On Error GoTo ErrHandler
ntwk.MapNetworkDrive driveLetter, filePath, False ', "username", "password"
If Len(Dir(driveLetter & "/" & newFolderName, vbDirectory)) = 0 Then
MkDir driveLetter & "/" & newFolderName
Else
MsgBox "Folder " & newFolderName & " already exists."
End If
ExitThis:
ntwk.RemoveNetworkDrive driveLetter
Exit Sub
ErrHandler:
Select Case Err.Number
Case -2147024829
MsgBox "Sharepoint site not found"
Case 76
'sharepoint directory not found
MsgBox "Mapping failed"
Case -2147024811
'drive already mapped
Resume Next
Case -2147022646
'drive not found and thus cannot be closed
Case -2147022495
MsgBox "This network connection has files open or requests pending." & vbNewLine & vbNewLine & _
"Either close the files or wait until the files are closed, then try to cancel the connection."
Case Else
MsgBox "Error " & Err.Number & ": " & vbNewLine & Err.Description
End Select
End Sub
Note for those of you desiring to continue to work on temporarily mapping SharePoint drives: this code work without any need for username or password (My company uses Authenticator), but only once you have logged in to SharePoint using Internet Explorer. I learned that, when using IE, an option under “All Documents” called “View in File Explorer” exists. It does not exist for Chrome or other browsers (as far as I know). My intent was to permanently map the drives, but once I had logged in from IE the code worked. You do not even have to stay logged in to IE and, when you return to the SharePoint via IE, you are still logged in (I have done this over a one day no-use period). I assume this something to do with the IE being a Microsoft product and therefore being trusted to keep login credentials.
Why is this code to run all enabled rules does not run in outlook-2016?
I used it without any problem on outlook 2007, 2010 and 2013, but it is not working in outlook 2016.
Sub OrginalRunActiveCatInboxRules()
Dim Session As Outlook.NameSpace
Dim Report As String
Dim currentItem As Object
Dim currentRule As Outlook.Rule
Dim rules As Outlook.rules
Dim ruleList As String
Set Session = Application.Session
Set rules = Session.DefaultStore.GetRules()
For Each currentRule In rules
If currentRule.RuleType = olRuleReceive Then
'determine if it’s an Inbox rule, if so, run it
If currentRule.Enabled Then
If Left(currentRule.name, 4) = "Cat." Then
MsgBox currentRule.name
currentRule.Execute ShowProgress:=True
' Sortering niet laten zien
' ruleList = ruleList & vbCrLf & currentRule.Name
End If
End If
End If
Next
' tell the user what you did
' ruleList = "These rules were executed against the Inbox: " & vbCrLf & ruleList
' MsgBox ruleList, vbInformation, "Macro: RunAllActiveInboxRules"
Set rules = Nothing
Set currentRule = Nothing
End Sub
The codes runs until next, but gives a error there. It does not matter if the first rule is enabled or not, starts with Cat. or not. It just won't go to the next item in the loop, but generates a error.
What can I do to make the code working again?
Check in the rules wizard if some of the rules are marked 'From other computer'.
If you have any like this, then the code will break at the line:
For Each currentRule In rules
I have the same issue now - took me a lot of troubleshooting to figure this out. One more thing that could be an issue: if any of the rules are broken, for example refer to a directory that does not exist, the rules object will not contain any rules.
If troubleshooting the above, remove all the suspicious rules and start adding them one by one back.
One of mine was marked "on this computer" when I unselected this option, the script worked again.
I use a outlook rule to process incoming mail via a VBA macro.
in the vba various actions are triggerd to process attachments of the incoming mail.
The problem is, there somethimes is a stack of e-mails that need to be processed.
I cant seem to find a way how to trigger the one by one.
I want to wait a few seconds before processing the next mail, if there is a stack.
Putting a sleep method in the macro doesnt seem to have effect. the rule doesnt seem to wait for the previous message to be done.
My method i something like:
Is there a way to accomplish this behaviour?
Private Sub ProcessMail(ByVal Item As Object)
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
If TypeOf Item Is Outlook.MailItem Then
Dim Msg As Outlook.MailItem
DoProcessingMethod
End If
End If
End Sub
Putting a wait or sleep in the method doesnt cause it to be processed one by one.
GD Arnold,
You could indeed use the ItemAdd option as per #Brett's answer.
I use a similar process to automatically upload received data (as attachment in an email) and upload this to a MySQL database. The action is triggered by the ItemAdd method and mails are checked one-by-one.
Simplified instructions:
Add a Class to your VBA code named "EventClassModule"
In your class, type
Public WithEvents dItems As Outlook.Items
In your ThisOutlookSession make a sub that registers the event_handler:
Sub Register_Event_Handler()
Set myClass.dItems = Outlook.Items
End Sub
In your ThisOutlookSession make a sub that handles the ItemAdd event as below:
Private Sub dItems_ItemAdd(ByVal newItem As Object)
On Error GoTo ErrorHandler
Dim msg As Outlook.MailItem
If newItem.Class = olMail Then
Set msg = newItem
'Do something with the msg item, check rules, check subject, check whatever
'This will process messages when the arrive in your mailbox one by one.
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
These steps should provide you with a sub that is triggered when a new mail arrives.
You could then call a function/sub like below.
The below sub runs all rules based on an optional ruleSet variable, it checks the rule.Name against the ruleSet and if the ruleSet string exists in the rule.Name then it executes some code. This way you can have multiple rules and only execute some of them based on which 'ruleSet' they are part of. You can define that by altering their name.
It's a refinement of the 'Run Rules' option in Outlook.
Some of this code came frome here: Setting VBA to read personal inbox
Sub runRules(Optional ruleSet As String)
Dim olStore As Outlook.Store
Dim myRules As Outlook.Rules
Dim tmpInbox As Outlook.Folder
Dim tmpSent As Outlook.Folder
Dim rl As Outlook.Rule
'On Error Resume Next
'toTmpBox (ruleSet)
' get default store (where rules live)
Set olStore = Application.Session.DefaultStore
With olStore
Set tmpInbox = .GetDefaultFolder(olFolderInbox) '.Folders("tmpInbox")
Set tmpSent = .GetDefaultFolder(olFolderSentMail) '.Folders("tmpSentBox")
End With
' get rules
Set myRules = olStore.GetRules
' iterate through all the rules
For Each rl In myRules
Debug.Print rl.Conditions.Body.Enabled & " " & rl.Conditions.Body.Text
If InStr(LCase(rl.Name), ruleSet) > 0 And (rl.Enabled) Then
rl.Execute ShowProgress:=True, Folder:=tmpInbox
If ruleSet = "autorun" Then
rl.Execute ShowProgress:=True, Folder:=olStore.GetDefaultFolder(olFolderSentMail)
End If
ruleList = ruleList & vbCrLf & rl.Name
End If
Next
' tell the user what you did
ruleList = "These rules were executed " & _
vbCrLf & ruleList
MsgBox ruleList, vbInformation, "Macro: RunMyRules"
CleanUp:
Set olStore = Nothing
Set tmpInbox = Nothing
Set tmpSent = Nothing
Set rl = Nothing
Set myRules = Nothing
End Sub
I have come across a similar problem. In my case my tool would run at regular time interval and each time I had to capture new emails only. Now new emails could be one or multiple. the solution I found was as given below.
Each time the tool would run. it will capture the new emails and just mark a simple ',' or '|' anything of your choice at the end of the subject in such a way that no one will notice. Now next time when the tool runs it checks if the emails received for the entire day or two (based on your requirements) has those markers or not.
This solution works if the email communication is one way. If we use these email for chain emails then their is another solution.
Here you will have to save the time max time of emails captured in the last run. Now each time you run you just have to run it for the entire day and put an if statement that is should be greater then time last captured.
Now to store the max time you might need to create a folder and an email. The email can help you to store the each time the run happens
item.subject = maxtime
item.save