Enable all rules from toolbar button?

[soadfan]

Hello there,
i have this issue which is described HERE (a screenshot of a MSO forum's thread)


Just for info i've added and 3 sec delay, but no luck:

Public Sub saveAttachtoDiskNL(itm As Outlook.MailItem)
Debug.Print "*** START NL_STT"
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
Dim yearFolder
dateFormat = Format(itm.ReceivedTime, "dd-mm-yyyy_hh-mm-ss-AMPM_")
yearFolder = Format(itm.ReceivedTime, "yyyy-mm")
saveFolder = "D:\TLC\STT_NL\" & yearFolder & "\"
On Error Resume Next
MkDir saveFolder
On Error GoTo 0
  For Each objAtt In itm.attachments
  Debug.Print "Found: " & objAtt.FileName & " at " & dateFormat
  If LCase(Right(objAtt.FileName, 4)) <> ".jpg" And LCase(Right(objAtt.FileName, 4)) <> ".png" Then
  Debug.Print "Confirmed as acceptable file type: " & objAtt.FileName & " at " & dateFormat
  objAtt.SaveAsFile saveFolder & dateFormat & "STT_NL" & LCase(Right(objAtt.FileName, 4))
  Debug.Print "Successful save: " & objAtt.FileName & " at " & dateFormat
  Debug.Print "Before wait:"; Now
  Call WaitFor(3)
  Debug.Print "After wait:"; Now
  Set objAtt = Nothing
  Debug.Print "Set objAtt = Nothing"
  Debug.Print "-------------------------------------------------------------------------------------------"
  End If
  Next
End Sub

and log:

*** START NL_STT
Found: WORKBOOK_4YX80QR9J004S642E8Q6AYLNX.ZIP at 16-06-2016_06-34-10-AM_
Confirmed as acceptable file type: WORKBOOK_4YX80QR9J004S642E8Q6AYLNX.ZIP at 16-06-2016_06-34-10-AM_
Successful save: WORKBOOK_4YX80QR9J004S642E8Q6AYLNX.ZIP at 16-06-2016_06-34-10-AM_
Before wait:Mon 16 June 06:34:38 AM
After wait:Mon 16 June 06:34:41 AM
Set objAtt = Nothing
-------------------------------------------------------------------------------------------

Now if i can't make it w0rk i want to be able to enable all disabled rules with one click.
Can anyone help with code for this?

P.S. I tried few google results and tried to adapt them to my needs, but also with no luck

Best regards,
Peter

 

[Diane Poremsky]

I would not delay the macro, at least not within the rule script. It causes outlook to wait and if two messages arrive at once, rules may not run on it.

I would use the rule's script to call the macro that does the work. This passes the work to a macro outside of the rule. It helped when i categorized Yammer messages based on the yammer group - failure rate dropped a lot, but there were still a few failures. (I received hundreds of messages a day from yammer, so it was always running.)

Public Sub saveAttachtoDiskNL(itm As Outlook.MailItem)
myMacro itm
End Sub

Public Sub myMacro(itm As Outlook.MailItem)
Debug.Print "*** START NL_STT"
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
Dim yearFolder
dateFormat = Format(itm.ReceivedTime, "dd-mm-yyyy_hh-mm-ss-AMPM_")
yearFolder = Format(itm.ReceivedTime, "yyyy-mm")
saveFolder = "D:\TLC\STT_NL\" & yearFolder & "\"
On Error Resume Next
MkDir saveFolder
On Error GoTo 0
  For Each objAtt In itm.attachments
  Debug.Print "Found: " & objAtt.FileName & " at " & dateFormat
  If LCase(Right(objAtt.FileName, 4)) <> ".jpg" And LCase(Right(objAtt.FileName, 4)) <> ".png" Then
  Debug.Print "Confirmed as acceptable file type: " & objAtt.FileName & " at " & dateFormat
  objAtt.SaveAsFile saveFolder & dateFormat & "STT_NL" & LCase(Right(objAtt.FileName, 4))
  Debug.Print "Successful save: " & objAtt.FileName & " at " & dateFormat
  Set objAtt = Nothing
  Debug.Print "Set objAtt = Nothing"
  Debug.Print "-------------------------------------------------------------------------------------------"
  End If
  Next
End Sub

The original thread is here - [Q]Outlook VBA macros running random

This macro runs rules now: Run Rules Now using a Macro

 

[soadfan]

Thanks, i'll try this

 

[soadfan]

Thanks, i'll try this

Well it fails too from time to time. So...can you help with VBA which enable all rules from a toolbar button?
I have 25+ rules and it's really annoying to re-enable disabled upon fail.

Best regards,
Peter