UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
3 Pages V < 1 2 3 >  (Go to first unread post)
   Reply to this topicStart new topic
> Outlook Freezes With Macro, Any Version    
 
   
dflak
post Oct 9 2018, 01:37 PM
Post#21


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


I'm back on the Outlook version.

I like your idea Jon. I'll plant a bunch of land mines and when I hear an explosion, I'll look to see where it is.

I've done this kind of thing before: set flags that get flipped when the code runs through them sort of like the semaphores used by railroads in the 1800's.

I thought you knew of some sort of logging program within Outlook sort of like Windows error logs.

If this were a "regular" error, I'd step through the code, but it's so intermittent I can't replicate it. It hasn't occurred since I re-activated it this morning, but I haven't sent or replied to a lot of emails today.

VB is VB, maybe I can make a VB script file that can be run by the task scheduler to do this. I used Excel because I am most familiar with it. Also I have "industrialized" the scheduling process. I have an Excel script template: you fill in the path name, the file name and the macro to run and it produces the string the task scheduler needs to open the script. The script has an on open event that runs the macro in the target workbook. So it's a "fill in the blanks" type of operation.

--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
JonSmith
post Oct 10 2018, 02:45 AM
Post#22


UtterAccess VIP
Posts: 4,051
Joined: 19-October 10



If my gut is right then no matter what language you do to this automation in (VBA, VBScript, Powershell) then the error will occur as its due to a hidden dialog. All of those languages will still make a hidden dialog appear.

Let us know what landmines get triggered, if its random then its perhaps a 'save draft mail' message or something. Either way we should start making the picture clearer.
Go to the top of the page
 
dflak
post Oct 10 2018, 10:33 AM
Post#23


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


There is a difference between the various methods. With the Outlook code, the timer is running in the background all the time. Other methods, outside Outlook, open a separate instance of Outlook, run it and then close. It is the closing of the Excel Script that is interfering with open Excel workbooks. That's why running a .vb file instead might work.

So far, my DoEvents seem to be holding the line but I haven't been composing or responding to a lot of mail today.

--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
cheekybuddha
post Oct 10 2018, 11:28 AM
Post#24


UtterAccess VIP
Posts: 11,463
Joined: 6-December 03
From: Telegraph Hill


You won't be able to use API calls from a vbscript (but you could use other forms of creating a timer).

d

--------------------


Regards,

David Marten
Go to the top of the page
 
dflak
post Oct 10 2018, 04:17 PM
Post#25


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


I don't need a timer in the code: I have the Windows Task Scheduler to do that for me.

I'm going to have to read up on vb scripts outside of Excel. Excel makes use of some libraries to talk to Outlook. This might not be do-able, but I haven't even started a search yet.

--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
JonSmith
post Oct 11 2018, 02:38 AM
Post#26


UtterAccess VIP
Posts: 4,051
Joined: 19-October 10



So my gut says that the issues are occurring when Outlook runs in the same instance. I seem to recall that Outlook is one of those weird ones where even if you specify a new instance in code it'll be tied to the one already open as so my assumption is/was this would remain true whether you use VBA in Outlook or Excel or if you use VBScript or Powershell.

Happy to be proved wrong!
Go to the top of the page
 
dflak
post Oct 11 2018, 07:56 AM
Post#27


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


You may be right. I may be crazy. smile.gif

I had to work with my IT department to get them to allow me to run a VB script and I have permission for only one folder. But it's enough. The script "compiles" but doesn't seem to be running properly. So I have debugging work to do.

But before I do that, I may again revisit my Excel version. There is one thing different about this workbook than the others I run from the task scheduler. This one I run only if logged in. The others run whether I am logged in or not and they run in the background. So I will switch it out and try that. I know from experience that even though I have Outlook on the machine and configured, it won't work if I am not logged in. I have to be logged in for any programs using Outlook to work, but since I will fire this event when I log in, that won't be an issue.

So I will have to delete the Outlook Code (again) and turn on the Task Scheduler and log out and log back in to try it.

--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
dflak
post Oct 18 2018, 08:47 AM
Post#28


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


I finally caught it in the act.

Here is my log file:

CODE
"10/18/2018 08:47:51 Initalizing Variables"
"10/18/2018 08:47:51 Initalizing Outlook"
"10/18/2018 08:47:51 Looping through folders"
"10/18/2018 08:47:51 Processing Amazon Daily Ops Reports"
"10/18/2018 08:47:51 Getting number of messages in Amazon Daily Ops Reports"
"10/18/2018 08:47:51 Processing Amazon Dock Master Data"
"10/18/2018 08:47:51 Getting number of messages in Amazon Dock Master Data"
"10/18/2018 08:47:51 Processing Amazon Forecast"
"10/18/2018 08:47:51 Getting number of messages in Amazon Forecast"
"10/18/2018 08:47:51 Adding Amazon Forecast count to mail body"
"10/18/2018 08:47:52 Processing Amazon Primary Volume Drivers"
"10/18/2018 08:47:52 Getting number of messages in Amazon Primary Volume Drivers"
"10/18/2018 08:47:52 Processing Cube Reports"
"10/18/2018 08:47:52 Getting number of messages in Cube Reports"
"10/18/2018 08:47:52 Processing Lulus"
"10/18/2018 08:47:52 Getting number of messages in Lulus"
"10/18/2018 08:47:52 Processing Pepsi Ops Rpt"
"10/18/2018 08:47:52 Getting number of messages in Pepsi Ops Rpt"
"10/18/2018 08:47:52 Clean up folder"
"10/18/2018 08:47:52 Sending message"
"10/18/2018 09:02:51 Initalizing Variables"
"10/18/2018 09:02:51 Initalizing Outlook"
"10/18/2018 09:02:51 Looping through folders"
"10/18/2018 09:02:51 Processing Amazon Daily Ops Reports"


It apparently crashed while attempting to access one of the sub-folders. I'll point out where in the code.

CODE
Sub MailAlert()
Dim olApp As Object                     ' Outlook Application
Dim olNS As Object                      ' Outlook Name Space
Dim FldrIn As Object                    ' Dock Schedule folder
Dim FldrOut As Object                   ' Dock Schedule processed folder

Dim olAtt As Object                     ' Outlook attachement
Dim MailBox As String                   ' Labor Analysis mailbox
Dim MailFolders() As String             ' Array of mail folders
Dim FolderNum As Long                   ' Folder number
Dim InFolder As String                  ' Mail folder to check

'Dim shL As Worksheet                    ' Mail message
Dim cl As String                         ' Generic Pointer
Dim MailBody As String                  ' Mail Body
Const olMailItem As Long = 0

Const LogPath As String = "C:\Users\dflak\Local\MailAlert"
Const LogFile As String = "MailLog.txt"

On Error GoTo ErrorExit

' Initalize variables
AppendToLog LogPath, LogFile, "Initalizing Variables"
MailBox = "Labor Analysis"
MailBody = ""
MailFolders = Split("Amazon Daily Ops Reports,Amazon Dock Master Data,Amazon Forecast,Amazon Primary Volume Drivers,Cube Reports,Lulus,Pepsi Ops Rpt", ",")

AppendToLog LogPath, LogFile, "Initalizing Outlook"
Set olNS = GetNamespace("MAPI")

AppendToLog LogPath, LogFile, "Looping through folders"
For FolderNum = 0 To UBound(MailFolders)
    AppendToLog LogPath, LogFile, "Processing " & MailFolders(FolderNum) '<------------------------ This is the "scene of the crime."
    InFolder = MailFolders(FolderNum)
    Set FldrIn = olNS.Folders(MailBox).Folders("Inbox").Folders(InFolder)
    DoEvents
    
    AppendToLog LogPath, LogFile, "Getting number of messages in " & InFolder
    If FldrIn.Items.Count > 0 Then
        AppendToLog LogPath, LogFile, "Adding " & InFolder & " count to mail body"
        MailBody = MailBody & "Folder " & InFolder & " has " & FldrIn.Items.Count & " items." & Chr(10)
        DoEvents
    End If
Next FolderNum

' Clean up Outlook
AppendToLog LogPath, LogFile, "Clean up folder"
Set FldrIn = Nothing
DoEvents

If MailBody <> "" Then
    ' Mail the message
    AppendToLog LogPath, LogFile, "Sending message"
    Mail_Workbook "daniel.flak@xpo.com", "Data Mail Alert!", MailBody
    DoEvents
Else
    AppendToLog LogPath, LogFile, "No message to send"
End If

Exit Sub

ErrorExit:
MsgBox Err.Number & Chr(10) & Err.Description, vbOKOnly, "An error has occurred."
End Sub

Sub Mail_Workbook(ToString As String, SubjectString As String, BodyString As String, _
    Optional CCString As String, Optional BCCString As String, Optional AttachmentName As String)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutMail = CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
        .To = ToString
        If CCString <> "" Then
            .CC = CCString
        End If
        If BCCString <> "" Then
            .BCC = BCCString
        End If
        .Subject = SubjectString
        .Body = BodyString
        If AttachmentName <> "" Then
            .Attachments.Add (AttachmentName)
        End If
        
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
End Sub

Sub AppendToLog(PathName As String, FileName As String, Message As String)
    Open PathName & "\" & FileName For Append As #1
    Write #1, Format(Now(), "mm/dd/yyyy hh:mm:ss") & " " & Message
    Close #1
End Sub

--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
cheekybuddha
post Oct 19 2018, 09:49 AM
Post#29


UtterAccess VIP
Posts: 11,463
Joined: 6-December 03
From: Telegraph Hill


Just a thought:

It looks like your folder loop has gone round again (the first folder processed is the same as the one that throws the error).

Instead of:
CODE
' ...
For FolderNum = 0 To UBound(MailFolders)
' ...

try assigning the UBound to a variable, instead of requerying on every loop pass:
CODE
' ...
Dim InFolder As String                  ' Mail folder to check
Dim FolderCount As Integer
' ...
FolderCount = UBound(MailFolders)
For FolderNum = 0 To FolderCount
' ...


MailFolders might be mutating whilst the code is running shrug.gif

hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
cheekybuddha
post Oct 19 2018, 09:51 AM
Post#30


UtterAccess VIP
Posts: 11,463
Joined: 6-December 03
From: Telegraph Hill


Oops! on closer inspection it's not gone round again, it's a new call of the function! blush.gif

Still worth a try though - maybe test the value of FolderCount before proceeding.

d

--------------------


Regards,

David Marten
Go to the top of the page
 
cheekybuddha
post Oct 19 2018, 09:56 AM
Post#31


UtterAccess VIP
Posts: 11,463
Joined: 6-December 03
From: Telegraph Hill


OK, so this must be the offending line:
CODE
' ...
    Set FldrIn = olNS.Folders(MailBox).Folders("Inbox").Folders(InFolder)
' ...


I would suggest adding a couple of DoEvents after:
CODE
' ...
Set olNS = GetNamespace("MAPI")
DoEvents
DoEvents
' ...

in case there is an issue with how long it takes to set that object, and the subsequent code is trying to access it before it's ready.

hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
dflak
post Oct 22 2018, 03:00 PM
Post#32


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


I agree with trying the Doevents. I'll try that when I get back in the office. I'm out this week.

I really would like to get this working. Functionally, it absolutely does everything I want it to do. It watches my mailboxes so I don't have to. Also, the most important time to check is in the mornings up until about lunch time. If I have a freeze after that, I kill Outlook and open it again and do NOT enable the macro.

--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
dflak
post Oct 24 2018, 03:13 PM
Post#33


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


I had three freezes today - I edited out all the stuff before the crash where things worked OK.

Freeze 1
"10/18/2018 17:21:10 Getting number of messages in Pepsi Ops Rpt"
"10/18/2018 17:21:10 Clean up folder"
"10/18/2018 17:21:10 No message to send"
"10/24/2018 09:09:31 Initalizing Variables"
"10/24/2018 09:09:31 Initalizing Outlook"

Freeze 2
"10/24/2018 13:29:26 Initalizing Variables"
"10/24/2018 13:29:26 Initalizing Outlook"
"10/24/2018 13:29:26 Looping through folders"
"10/24/2018 13:29:26 Processing Amazon Daily Ops Reports"

Freeze 3
"10/24/2018 14:02:07 Initalizing Variables"
"10/24/2018 14:02:07 Initalizing Outlook"
"10/24/2018 14:02:07 Looping through folders"
"10/24/2018 14:02:07 Processing Amazon Daily Ops Reports"
"10/24/2018 14:02:07 Getting number of messages in Amazon Daily Ops Reports"

The current code has a DoEvent after EVERY line. I will see if that works. I'm not too sure if DoEvents is the proper thing. In VBA one line of code should not execute until the line above completes. DoEvents (in my understanding) means wait for other processes to complete. Anyway I'll see if they help.

CODE
Sub MailAlert()
Dim olApp As Object                     ' Outlook Application
Dim olNS As Object                      ' Outlook Name Space
Dim FldrIn As Object                    ' Dock Schedule folder
Dim FldrOut As Object                   ' Dock Schedule processed folder

Dim olAtt As Object                     ' Outlook attachement
Dim MailBox As String                   ' Labor Analysis mailbox
Dim MailFolders() As String             ' Array of mail folders
Dim FolderNum As Long                   ' Folder number
Dim InFolder As String                  ' Mail folder to check

'Dim shL As Worksheet                    ' Mail message
Dim cl As String                         ' Generic Pointer
Dim MailBody As String                  ' Mail Body
Const olMailItem As Long = 0

Const LogPath As String = "C:\Users\dflak\Local\MailAlert"
Const LogFile As String = "MailLog.txt"

On Error GoTo ErrorExit

' Initalize variables
DoEvents
AppendToLog LogPath, LogFile, "Initalizing Variables"
DoEvents
MailBox = "Labor Analysis"
DoEvents
MailBody = ""
DoEvents
MailFolders = Split("Amazon Daily Ops Reports,Amazon Dock Master Data,Amazon Forecast,Amazon Primary Volume Drivers,Cube Reports,Lulus,Pepsi Ops Rpt", ",")
DoEvents

AppendToLog LogPath, LogFile, "Initalizing Outlook"
DoEvents

Set olNS = GetNamespace("MAPI")
DoEvents

AppendToLog LogPath, LogFile, "Looping through folders"
For FolderNum = 0 To UBound(MailFolders)
    DoEvents
    AppendToLog LogPath, LogFile, "Processing " & MailFolders(FolderNum)
    DoEvents
    InFolder = MailFolders(FolderNum)
    DoEvents
    Set FldrIn = olNS.Folders(MailBox).Folders("Inbox").Folders(InFolder)
    DoEvents
    
    AppendToLog LogPath, LogFile, "Getting number of messages in " & InFolder
    DoEvents
    If FldrIn.Items.Count > 0 Then
        DoEvents
        AppendToLog LogPath, LogFile, "Adding " & InFolder & " count to mail body"
        DoEvents
        MailBody = MailBody & "Folder " & InFolder & " has " & FldrIn.Items.Count & " items." & Chr(10)
        DoEvents
    End If
    DoEvents
Next FolderNum

' Clean up Outlook
AppendToLog LogPath, LogFile, "Clean up folder"
DoEvents
Set FldrIn = Nothing
DoEvents
DoEvents

' Program never crashes below this line.

If MailBody <> "" Then
    DoEvents
    ' Mail the message
    AppendToLog LogPath, LogFile, "Sending message"
    DoEvents
    Mail_Workbook "daniel.flak@xpo.com", "Data Mail Alert!", MailBody
    DoEvents
Else
    DoEvents
    AppendToLog LogPath, LogFile, "No message to send"
    DoEvents
End If

Exit Sub

ErrorExit:
' Program never issues a warning message on crash
MsgBox Err.Number & Chr(10) & Err.Description, vbOKOnly, "An error has occurred."
End Sub

Sub Mail_Workbook(ToString As String, SubjectString As String, BodyString As String, _
    Optional CCString As String, Optional BCCString As String, Optional AttachmentName As String)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutMail = CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
        .To = ToString
        If CCString <> "" Then
            .CC = CCString
        End If
        If BCCString <> "" Then
            .BCC = BCCString
        End If
        .Subject = SubjectString
        .Body = BodyString
        If AttachmentName <> "" Then
            .Attachments.Add (AttachmentName)
        End If
        
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
End Sub

Sub AppendToLog(PathName As String, FileName As String, Message As String)
    Open PathName & "\" & FileName For Append As #1
    Write #1, Format(Now(), "mm/dd/yyyy hh:mm:ss") & " " & Message
    Close #1
End Sub


--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
cheekybuddha
post Oct 24 2018, 04:50 PM
Post#34


UtterAccess VIP
Posts: 11,463
Joined: 6-December 03
From: Telegraph Hill


Dan,

I can't see in the code of MailAlert() where you set olNS and olApp to Nothing.

Same goes for OutApp in Mail_Workbook()

You should probably clean up these objects in your clean up code.

Even better would be to have a module level outlook application object variable and a function that returns it, setting it if required, since you should only need one instance for both procedures.

hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
JonSmith
post Oct 25 2018, 03:11 AM
Post#35


UtterAccess VIP
Posts: 4,051
Joined: 19-October 10



This is interesting. The variable moments that the code stops indicates that its some external factor triggering it. This is good information to know.

Ok so I suggest that as soon as you instance the second Outlook application you make it visible. See if any hidden dialogs pop up.
Does you Excel file that runs the code stay open in the background indefinitely too? If so I'd also suggest making sure that it is visible and to make the Outlook application public and keep it open even when the code is running so you aren't opening and closing Outlook alot. If you are using Windows 10 we can probably work out something that helps this run on a separate desktop so it doesn't clutter your main desktop?

JS
Go to the top of the page
 
dflak
post Oct 25 2018, 08:14 AM
Post#36


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


I'll implement the cleanup.

"Even better would be to have a module level outlook application object variable and a function that returns it, setting it if required, since you should only need one instance for both procedures." - OK, you're going to have to explain this one to me. You lost me here. smile.gif.

Thanks for sticking with me on this. I know VBA very well as it applies to Excel and even Access. I played a bit with VBA in PowerPoint and Word. This is my first attempt at Outlook (from within Outlook - I have Excel tools to read and send mail) so I am doing this "cookbook" style: just following directions without actually knowing what I am doing.

--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
JonSmith
post Oct 25 2018, 10:30 AM
Post#37


UtterAccess VIP
Posts: 4,051
Joined: 19-October 10



Sorry, I thought we were back in Excel again. I checked your code and its running in Outlook so the global variable doesn't apply.

I have inserted it into my own Outlook. I'm gonna clean it up and run it to see if I can recreate and do some testing myself.

How are you triggering it every 15 minutes in Outlook Dan?
This post has been edited by JonSmith: Oct 25 2018, 10:34 AM
Go to the top of the page
 
dflak
post Oct 25 2018, 03:01 PM
Post#38


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


Before I start, I need to mention that the Error trapping seems to work. About every other day, the msgbox will pop up an error and Outlook continues on its way without freezing.

Yesterday, I left a mail draft open for about an hour and every couple of minutes typed a line. The code did not freeze while the message was open and idle. It only crashed as I was actually typing while the macro kicked off.

The following code is in ThisOutlook Session. I did not write this. The only change I made was to call the timer every 15 minutes instead of 1.
CODE
Private Sub Application_Quit()
  If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting **VERY IMPORTANT**
End Sub

Private Sub Application_Startup()
  MsgBox "Activating the Timer."
  Call ActivateTimer(15) 'Set timer to go off every 1 minute
End Sub


This is the code in the standard module. It will need a lot of cleaning up to remove the debugging stuff.
CODE
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running

Public Sub ActivateTimer(ByVal nMinutes As Long)
  nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes
  If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer
  TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer)
  If TimerID = 0 Then
    MsgBox "The timer failed to activate."
  End If
  DoEvents
End Sub

Public Sub DeactivateTimer()
Dim lSuccess As Long
  lSuccess = KillTimer(0, TimerID)
  If lSuccess = 0 Then
    MsgBox "The timer failed to deactivate."
  Else
    TimerID = 0
  End If
  DoEvents
End Sub

Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
  ' MsgBox "The TriggerTimer function has been automatically called!"
  ' Place VB Code Here
  Call MailAlert
End Sub

Sub MailAlert()
Dim olApp As Object                     ' Outlook Application
Dim olNS As Object                      ' Outlook Name Space
Dim FldrIn As Object                    ' Dock Schedule folder
Dim FldrOut As Object                   ' Dock Schedule processed folder

Dim olAtt As Object                     ' Outlook attachement
Dim MailBox As String                   ' Labor Analysis mailbox
Dim MailFolders() As String             ' Array of mail folders
Dim FolderNum As Long                   ' Folder number
Dim InFolder As String                  ' Mail folder to check

'Dim shL As Worksheet                    ' Mail message
Dim cl As String                         ' Generic Pointer
Dim MailBody As String                  ' Mail Body
Const olMailItem As Long = 0

Const LogPath As String = "C:\Users\dflak\Local\MailAlert"
Const LogFile As String = "MailLog.txt"

On Error GoTo ErrorExit

' Initalize variables
DoEvents
AppendToLog LogPath, LogFile, "Initalizing Variables"
DoEvents
MailBox = "Labor Analysis"
DoEvents
MailBody = ""
DoEvents
MailFolders = Split("Amazon Daily Ops Reports,Amazon Dock Master Data,Amazon Forecast,Amazon Primary Volume Drivers,Cube Reports,Lulus,Pepsi Ops Rpt", ",")
DoEvents

AppendToLog LogPath, LogFile, "Initalizing Outlook"
DoEvents

Set olNS = GetNamespace("MAPI")
DoEvents

AppendToLog LogPath, LogFile, "Looping through folders"
For FolderNum = 0 To UBound(MailFolders)
    DoEvents
    AppendToLog LogPath, LogFile, "Processing " & MailFolders(FolderNum)
    DoEvents
    InFolder = MailFolders(FolderNum)
    DoEvents
    Set FldrIn = olNS.Folders(MailBox).Folders("Inbox").Folders(InFolder)
    DoEvents
    
    AppendToLog LogPath, LogFile, "Getting number of messages in " & InFolder
    DoEvents
    If FldrIn.Items.Count > 0 Then
        DoEvents
        AppendToLog LogPath, LogFile, "Adding " & InFolder & " count to mail body"
        DoEvents
        MailBody = MailBody & "Folder " & InFolder & " has " & FldrIn.Items.Count & " items." & Chr(10)
        DoEvents
    End If
    DoEvents
Next FolderNum

' Clean up Outlook
AppendToLog LogPath, LogFile, "Clean up folder"
DoEvents
Set FldrIn = Nothing
DoEvents
DoEvents

' Program never crashes below this line.

If MailBody <> "" Then
    DoEvents
    ' Mail the message
    AppendToLog LogPath, LogFile, "Sending message"
    DoEvents
    Mail_Workbook "daniel.flak@xpo.com", "Data Mail Alert!", MailBody
    DoEvents
Else
    DoEvents
    AppendToLog LogPath, LogFile, "No message to send"
    DoEvents
End If

Exit Sub

ErrorExit:
' Program never issues a warning message on crash
MsgBox Err.Number & Chr(10) & Err.Description, vbOKOnly, "An error has occurred."
End Sub

Sub Mail_Workbook(ToString As String, SubjectString As String, BodyString As String, _
    Optional CCString As String, Optional BCCString As String, Optional AttachmentName As String)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutMail = CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
        .To = ToString
        If CCString <> "" Then
            .CC = CCString
        End If
        If BCCString <> "" Then
            .BCC = BCCString
        End If
        .Subject = SubjectString
        .Body = BodyString
        If AttachmentName <> "" Then
            .Attachments.Add (AttachmentName)
        End If
        
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
End Sub

Sub AppendToLog(PathName As String, FileName As String, Message As String)
    Open PathName & "\" & FileName For Append As #1
    Write #1, Format(Now(), "mm/dd/yyyy hh:mm:ss") & " " & Message
    Close #1
End Sub

--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
dflak
post Nov 5 2018, 12:45 PM
Post#39


Utter Access VIP
Posts: 6,283
Joined: 22-June 04
From: North Carolina


Just updating the situation. I have a Doevents between every line of code and I did the cleanup as indicated. I still freeze but is consistently when I am counting the number of messages in a folder. Sometimes it will get a couple of folders down the list before freezing.

CODE
    ' Program seems to fail here *****************************************
    If FldrIn.Items.Count > 0 Then

--------------------
Dan

One spreadsheet to rule them all. One spreadsheet to find them. One spreadsheet to bring them all and at corporate, bind them.
Please zip and attach samples. It makes life easier for those who have to figure out what you are trying to do. Thanks
Go to the top of the page
 
cheekybuddha
post Nov 5 2018, 05:06 PM
Post#40


UtterAccess VIP
Posts: 11,463
Joined: 6-December 03
From: Telegraph Hill


It's a weird one, Dan!

The only extra addition I can suggest to the code as you have it is to add:
CODE
' ...
    If FldrIn.Items.Count > 0 Then
        DoEvents
        AppendToLog LogPath, LogFile, "Adding " & InFolder & " count to mail body"
        DoEvents
        MailBody = MailBody & "Folder " & InFolder & " has " & FldrIn.Items.Count & " items." & Chr(10)
        DoEvents
    End If
    Set FldrIn = Nothing      ' <-- explicitly set the folder to nothing before it is set again in the next loop
    DoEvents
Next FolderNum
' ...

In the absence of any other suggestions, it can't harm to try it!

At the place where I am currently working they have just upgraded to Office365 and the machine I use there has Outlook on it now, so if I get some spare moments (or rather when I can't face work any more wary.gif ) I'll see if I can test and replicate what you're seeing.

d

--------------------


Regards,

David Marten
Go to the top of the page
 
3 Pages V < 1 2 3 >


Custom Search


RSSSearch   Top   Lo-Fi    21st August 2019 - 08:07 PM