Question : Debugging/Modifying VB Code for Macro in Excel

Hi,

I have the following code that was provided by will_scarlet7 from the Outlook Experts Exchange page.  

It's a Macro using Outlook Redemption that when run brings up a dialog box that allows the user to choose a particular mailbox from Outlook and then proceeds to read the contents of that mailbox transferring the fields specified in the Macro into an Excel spreadsheet.  Now the Macro below contains basic fields, but I'll add in the exact fields from the Outlook Custom forms later.

I'd be grateful if someone could run this macro and tell me what they think - I have the following issues that I'd be grateful for advice on:

*  When I run the Macro depending on the Mailbox I choose I sometimes get a VB dialog box with only the crtitcal message sign.  Why does that happen - is there somethign wrong with my machine?
*   Run time error 4096 - One or more of the items you synchronised do not match.To resolve the conflicts open the items and then try this operation again.  How do I trap all possibel errors so that it the Macro doesn't fall over here?
 

Sub SaveAttachments()

Dim oOutlook As Outlook.Application
Dim mAttach As Object
Dim oNs As Outlook.Namespace
Dim oFldr As Outlook.MAPIFolder
Dim oMessage As Object
Dim oSfMsg As Redemption.SafeMailItem
Dim oAttachment As Redemption.Attachment
Dim iCtr, rCtr As Integer
Dim iAttachCnt As Integer
Dim mSubject, mAttName, mAttName1, mAttName2, mFrom, mBody As String
Dim mAttachments As String

'if user cancels Outlook Folder picker
On Error GoTo SaveErrHndlr

'Set and pick the Outlook folder to save info from
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.PickFolder
Set mAttach = CreateObject("Scripting.FileSystemObject")
Set oSfMsg = CreateObject("Redemption.SafeMailItem")

'Reset error handler to default
On Error GoTo 0


'Get first blank row num
rCtr = GetRowNum

'Scan through each mail item in the selected Outlook folder
'   recording the e-mail info to
'   the current worksheet
For Each oMessage In oFldr.Items
    oSfMsg.Item = oMessage
    If oSfMsg.Unread = True Then 'Only process unread emails
        mSubject = oSfMsg 'Get e-mail subject
        mFrom = oSfMsg.SenderName 'Get e-mail SendersName
        mBody = oSfMsg.Body 'Get e-mail message body
        mAttachments = ""
        'Look for attachments in the current mail item.
        With oSfMsg.Attachments
            mAttName = ""
            iAttachCnt = .Count
            'If attachments exist in the current mail item
            If iAttachCnt > 0 Then
                'Do the following for each attachment in the current mail item.
                For iCtr = 1 To iAttachCnt
                    mAttName = .Item(iCtr).Filename 'Get original file name of the attachment
                    mAttachments = mAttachments & "    " & mAttName & vbCrLf
                Next iCtr
            Else 'No attachment exists in the current mail item
                mAttachments = "No files attached to the e-mail."
            End If
        End With
        'Append e-mail info
        Range("A" + Trim(Str(rCtr))).Value = mFrom
        Range("B" + Trim(Str(rCtr))).Value = mSubject
        Range("C" + Trim(Str(rCtr))).Value = mBody
        Range("D" + Trim(Str(rCtr))).Value = mAttachments
        'AppendAttachmentInfo mAttachments, mSubject, mFrom, mBody
        DoEvents
        'Now mark email as read.
        oSfMsg.Unread = False
        rCtr = rCtr + 1
    End If
Next oMessage

GoTo CloseSaveAttachments

'If user cancels Outlook Folder selection
SaveErrHndlr:
    If Err.Description = "Object variable or With block variable not set" Then
        MsgBox "Canceled by user.", vbOKOnly, "Closing"
    End If
    GoTo CloseSaveAttachments
   
'Release environment objects
CloseSaveAttachments:
    Set oMessage = Nothing
    Set oFldr = Nothing
    Set oNs = Nothing
    Set oOutlook = Nothing
    Set oSfMsg = Nothing

End Sub

Function GetRowNum() As Integer

    Dim rowNum As Integer
    Dim cellVal As String

    rowNum = 1

    cellVal = Range("A" + Trim(Str(rowNum))).Value
   
    'If cell A1 is empty then assume it is a blank worksheet
    ' and proceede to format the first row a column headers
    If cellVal = "" Then
        FrmtColHdr
        GetRowNum = 2
    Else
        'else assume that you are adding to a previously formated
        'worksheet, so find the next empty row for column A
        Do While cellVal <> ""
            rowNum = rowNum + 1
            cellVal = Range("A" + Trim(Str(rowNum))).Value
        Loop
    End If
   
End Function

Function FrmtColHdr()

    'Format column widths
    Columns("A:A").ColumnWidth = 10 'From
    Columns("B:B").ColumnWidth = 40 'Subject
    Columns("C:C").ColumnWidth = 40 'Body
    Columns("D:D").ColumnWidth = 40 'Attachments

    'Fill in Column Headers
    Range("A1").Value = "From"
    Range("B1").Value = "Subject"
    Range("C1").Value = "Message Body"
    Range("D1").Value = "Attachments"
   
End Function



Run time error 4096 - One or more of the items you synchronised do not match.To resolve the conflicts open the items and then try this operation again"

Answer : Debugging/Modifying VB Code for Macro in Excel

Andrew, are you still working on this today? I've posted a link to this thread in the Programming ->VB section to see if we can't get some input from the wise and learned over there.

        Assuming that you have done what I suggested in my previous post (re-booted) and are still getting the "System Error &H8000FFFF (-2147418113)" error, my next thought would be that something is messed up in the excel file somehow. So my next suggestion would be to create a blank worksheet and paste in the code that you posted this morning in this thread and see if it will run from a new worksheet.
        I know this may sound pointless and like why would that work, but I have a database that has had a similar problem and the only way to fix it was pretty much this.

Let me know if I should keep trying this afternoon or if you are going to put it asside til later, OK.

Sam.