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 Dec 14 2018, 04:03 PM
Post#41


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


Just an update, but as you can see by the logs, it's been a while since I've used the macro. At least it is being consistent. It is failing at the indicated point all the time.

"11/21/2018 11:13:00 Initalizing Variables"
"11/21/2018 11:13:00 Initalizing Outlook"
"11/21/2018 11:13:00 Looping through folders"
"11/21/2018 11:13:00 Processing Amazon Daily Ops Reports"
"11/21/2018 11:13:00 Getting number of messages in Amazon Daily Ops Reports"


The following is the latest version of the code
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 MsgCount As Long                    ' Number of messages in the folder.

'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
    DoEvents
    
    AppendToLog LogPath, LogFile, "Getting number of messages in " & InFolder
    DoEvents
    DoEvents
    ' Program seems to fail here *****************************************
    MsgCount = FldrIn.Items.Count
    DoEvents
    AppendToLog LogPath, LogFile, "Comparing message count for " & InFolder
    If MsgCount > 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
Set olNS = Nothing
Set olApp = 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
    Const LogPath As String = "C:\Users\dflak\Local\MailAlert"
    Const LogFile As String = "MailLog.txt"

    AppendToLog LogPath, LogFile, "Mailworkbook: Create Outlook object to send."
    Set OutMail = CreateItem(0)
    DoEvents
    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
        
        AppendToLog LogPath, LogFile, "Mailworkbook: Send the message."
        .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

Sub Test()
Dim MsgString As String
MsgString = Format(Now(), "mm/dd/yyyy hh:mm:ss") & " Hello World"
AppendToLog "C:\Users\dflak\Temp", "MailLog.txt", MsgString

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 Dec 17 2018, 09:53 AM
Post#42


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


I have not been able to figure out a way to keep the program from freezing, however I have a work-around. I have found code that tells me whether a message is open for editing. I can put this into a sleep loop and delay the program from running until the message being edited is closed.

I will post a link to this solution once I test it out and clean up the code.

--------------------
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 Dec 17 2018, 03:00 PM
Post#43


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


Well, the "Don't call the macro until the message is finished" idea didn't work. It seems that the basic issue is that you cannot edit a message while any macro is running. I have evidence via log files that with the wait loop scheme, the macro was running happily behind the scenes when the edit window was opened and locked. Because it was locked, the edit window could never be unlocked. I'm wondering if that is what is causing the original problem: Outlook is waiting for the edit window to close so it can continue running the macro. Only thing is, you can't close the edit window because it is locked because a macro is running.

It doesn't really explain why the macro starts running and then freezes but I'll go with it. Perhaps when I try to count the number of messages in a folder (the point where it seems to fail), it needs to check to see if I am making a response to one of the messages in the folder.

Anyway, I came up with a variation on the theme. if the edit window is open when the timer says, "Run the code." I skip running the code and the macro exits and the edit window is not locked. The timer tries again in 5 minutes. If the edit window is closed, it does a second check to see if at least 15 minutes had elapsed since the last execution of the Mail Folder Check. So it works out that I get a mail check no more than 5 minutes after closing the edit window or 15 minutes since the last check, whichever is longer. It's good enough for my purposes.

Here is the solution: https://www.excelforum.com/tips-and-tutoria...tml#post5029090.

--------------------
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
 
3 Pages V < 1 2 3


Custom Search


RSSSearch   Top   Lo-Fi    18th February 2019 - 05:10 AM