Excel VBA code only works in debug mode

Question

I've already searched in a bunch of topics and no solution seemed to work for me.

I've an Excel macro file that sometimes works fine, but sometimes only works in stepping mode.

This is a sub inside a main sub that passes a value (message) to a spreadsheet from an Outlook Calendar by category (key). (for this code I adapted from Script to total hours by calendar category in Outlook) .The value goes into the row with the same name as the category and the week value in the column. I've tried the DoEvents and I thought it had worked, but when I tried to run it in a different computer it failed again.

Any ideas?

Option Explicit
Public keyArray
Sub totalCategories()


Dim app As New Outlook.Application
Dim namespace As Outlook.namespace
Dim calendar As Outlook.Folder
Dim appt As Outlook.AppointmentItem
Dim apptList As Outlook.Items
Dim apptListFiltered As Outlook.Items
Dim startDate As String
Dim endDate As String
Dim category As String
Dim duration As Integer
Dim outMsg As String
Dim firstDayOfTheYear As Date

'Going to be used to get start and end date
firstDayOfTheYear = Date
firstDayOfTheYear = "01/01/" & Right(firstDayOfTheYear, 4)

' Access appointment list
Set namespace = app.GetNamespace("MAPI")
Set calendar = namespace.GetDefaultFolder(olFolderCalendar)
Set apptList = calendar.Items

' Include recurring appointments and sort the list
apptList.IncludeRecurrences = True
apptList.Sort "[Start]"

' Get selected date
startDate = firstDayOfTheYear + 7 * (CInt(SelectWeek.week) - 1)
endDate = firstDayOfTheYear + 7 * (CInt(SelectWeek.week) - 1) + 6
startDate = Format(startDate, "dd/MM/yyyy") & " 00:01"
endDate = Format(endDate, "dd/MM/yyyy") & " 11:59 PM"

' Filter the appointment list
Dim strFilter As String
strFilter = "[Start] >= '" & startDate & "'" & " AND [End] <= '" & endDate & "'"
Set apptListFiltered = apptList.Restrict(strFilter)

' Loop through the appointments and total for each category
Dim catHours
Set catHours = CreateObject("Scripting.Dictionary")
For Each appt In apptListFiltered
    category = appt.Categories
    duration = appt.duration
    If catHours.Exists(category) Then
        catHours(category) = catHours(category) + duration
    Else
        catHours.Add category, duration
    End If
Next

' Loop through the categories
Dim key
keyArray = catHours.Keys
DoEvents 'prevents a bug from happening --> in some cases the total hours weren't divided by categories
For Each key In keyArray
    outMsg = catHours(key) / 60
    'Print in Realizado sheet --> activities must be in range (name manager) as "atividades"
    writeReport SelectWeek.week, outMsg, key
Next

' Clean up objects
Set app = Nothing
Set namespace = Nothing
Set calendar = Nothing
Set appt = Nothing
Set apptList = Nothing
Set apptListFiltered = Nothing

End Sub

Sub writeReport(week, message As String, key)

    Dim ws As Worksheet
    Dim i As Integer
    Dim Activities, nActivities As Integer

    Set ws = Sheets("5")
    Activities = Range("activities")
    nActivities = UBound(Activities)
    DoEvents
    For i = 1 To nActivities
        DoEvents 
        If key = Cells(i + 8, 2).Value Then
            ws.Cells(i + 8, week + 3).Value = CDbl(message)
            Exit For
        End If
    Next i

End Sub

Declare all your variable types, state whether passed ByVal or ByRef, use explicit worksheet and workbook reference i.e. use their names and not just Cells. Is there a sheet that is really called 5? CDbl on string message? And this lacks the context of how used in outlook....and called using Excel.Application....... And use Long rather Integer. Sort those things out and be sure to have Option Explicit at top of modules and see if problem persists. — QHarr
– QHarr, Commented Apr 10, 2018 at 14:39

addohm · Accepted Answer · 2018-04-10 21:41:09Z

5

You need to handle errors explicitly so you know exactly what is going on. Trust me that this will save you HEAPS of time troubleshooting your own code, especially in VBA.

Common practice is something like "try, catch, finally".

Dim position as string

Sub foo()
  position = "sub function short description"
  On Error GoTo catch
  Err.Clear

  'do stuff

finally:
  On Error Resume Next
  'do cleanup stuff

  Exit Sub

catch:
  Debug.Print Right(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 3) & ", _
  Position: " & errorPosition & " , Error Code: [ " & Hex(Err.number) & "], _
  Description: " & Err.Description & ""
  Resume finally

End Sub

edited Apr 10, 2018 at 21:41

answered Apr 10, 2018 at 15:28

addohm

2,5053 gold badges20 silver badges44 bronze badges

Sign up to request clarification or add additional context in comments.

Comments

lnros · Accepted Answer · 2018-04-10 17:03:48Z

0

Problem solved!

From this:

    If key = Cells(i + 8, 2).Value Then
        ws.Cells(i + 8, week + 3).Value = CDbl(message)
        Exit For
    End If

To this:

    If key = Activities(i, 1) Then
        ws.Cells(i + 8, week + 3).Value = CDbl(message)
        Exit For
    End If

answered Apr 10, 2018 at 17:03

lnros

253 silver badges6 bronze badges

Collectives™ on Stack Overflow

Excel VBA code only works in debug mode

2 Answers 2

Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related