Hello all, recently, one of our vb apps starting throwing a memory error when
exiting.  The error states "The memory could not be read.  Click on OK to
terminate the program".  This apps contains a Flex Grid Control, housing
anywhere from 1100 to 1400 records.  The app processes each row into another
application database.  Once the records are processed, the user exits the
program and then gets the memory error.  I have found several references to
the error using Google, but nothing has been useful as of yet.  I found a
download of a hotfix for the Windows common controls, but not the Flex Grid
Control.  Any ideas or suggestions ?  Please let me know............Thanks.

Show quote Hide quote Are you sure its a flexgrid problem? Is this problem in the IDE, exe or
both? Is there any subclassing or hooks enabled in the app? If it's only in
the IDE, what Add-Ins are you running? I can't recall the flexgrid causing
too many problems. It's an ancient control so all of the bugs should be dead
by now. We need more info.

blaine67 <blain***@discussions.microsoft.com>'s wild
thoughts were released on Wed, 22 Mar 2006 12:21:32 -0800
bearing the following fruit:

I agree with Ken, it's not likely to be due the MSFlexgrid
and my advice would be to look elsewhere as the cause to the
problem.

Could you post the code that 'processes every row'? The
problem may not be located there but we could give your code
the once over if you like (providing the code isn't too
lone)





Jan Hyde (VB MVP)

Thank you both for your replies.  The code is posted below.  It consists of
one form and one module.  Please exuse the code for structure, as it's not
mine.  To process the grid it pulls data from a SQL table and then uploads
data to a product called Matrix One via an ODBC entry.  It's interesting,
just starting the product and then hitting the exit button creates the memory
error....

Here's the form code with some
functions...............................................

Option Explicit

Private Sub cmdCancel_Click()
    cmdCancel.Enabled = False
    cmdUpLoad.Enabled = True
    cmdNetChange.Enabled = True
End Sub

Private Sub cmdNetChange_Click()
    cmdUpLoad.Enabled = False
    flxTDM.Rows = 1
    DoEvents
    Call fnGetSQLData(flxTDM)
    If flxTDM.Rows > 0 Then
      cmdUpLoad.Enabled = True
    End If
End Sub

Private Sub cmdUpLoad_Click()
    If flxTDM.Rows > 0 Then
        cmdUpLoad.Enabled = False
        cmdNetChange.Enabled = False
        cmdCancel.Enabled = True
        Call fnLoopNetChange
    Else
        MsgBox "There are no records to Upload!", vbExclamation + vbOKOnly,
"No Records"
    End If
    cmdCancel.Enabled = False
End Sub

Private Sub Command1_Click()
    On Error GoTo Command1_Click_Error

    Label2(0) = ""
    Label2(1) = ""
    Label2(2) = ""
    Label6 = ""
    Text1 = ""
    flx2.Rows = 1

    Call fnGetData("BUSINESS_OBJECT", "", flx1)

Command1_Click_Exit:
    Exit Sub
Command1_Click_Error:
    LogErrorMsg Err, Error, "Command1_Click", "", True
    GoTo Command1_Click_Exit
End Sub

Private Sub Command2_Click()
   Call Form_Unload(True)
End Sub

Private Sub Command3_Click()
    Call fnSetData
End Sub

Private Sub Command4_Click()
    If fraSQL.Visible = True Then
        cmdNetChange.Enabled = False
        cmdUpLoad.Enabled = False
        fraSQL.Visible = False
    Else
        cmdNetChange.Enabled = True
        If Me.flxTDM.Rows > 0 Then
            cmdUpLoad.Enabled = True
        End If
        fraSQL.Visible = True
        fraSQL.ZOrder (0)
    End If
End Sub

Private Sub flx1_Click()
    With flx1
        Call fnGetData("BUSINESS_OBJECT_LONG_STRING_ATTRIBUTE",
..TextMatrix(.Row, 0), flx2)
        Label2(0) = .TextMatrix(.Row, 2)
        Label2(1) = .TextMatrix(.Row, 3)
        Label2(2) = .TextMatrix(.Row, 4)
        Label6 = .TextMatrix(.Row, 0)
    End With
End Sub

Private Sub fnGetData(strParam0 As String, strParam1 As String, FLX As
MSFlexGrid)
    On Error GoTo fnGetData_Error
    Dim rsADOObject As Recordset
    Dim strSQL As String
    Dim strRow As String
    Dim intI As Integer
    Dim intJ As Integer

    Screen.MousePointer = vbHourglass
    If strParam0 = "BUSINESS_OBJECT" Then
        strSQL = "SELECT * FROM " & strParam0 & " WHERE NAME = '" &
UCase(Trim(txt1(1))) & "'  ORDER BY REVISION" 'AND REVISION LIKE  '" &
UCase(Trim(txt1(2))) & "?'
    Else
        strSQL = "SELECT * FROM " & strParam0 & "  WHERE OID = '" &
strParam1 & "' ORDER BY ATTRIBUTE_NAME"
    End If
    Set rsADOObject = curMatrixDB.OpenRecordset(strSQL, dbOpenDynaset)
    If strParam0 = "BUSINESS_OBJECT" Then
        intJ = rsADOObject.Fields().Count - 1
    Else
        intJ = rsADOObject.Fields().Count - 1
    End If
    FLX.Rows = 0
    strRow = rsADOObject(0).Name
    FLX.Cols = intJ + 1
    For intI = 1 To intJ
        strRow = strRow & vbTab & rsADOObject(intI).Name
    Next intI
    With FLX
        .AddItem strRow
        .Rows = 2
        .FixedRows = 1
        If strParam0 <> "BUSINESS_OBJECT" Then
            .ColWidth(0) = 3000
            .ColWidth(1) = 3000
            .ColWidth(2) = .Width - 6350
            .ColAlignment(0) = 0
            .ColAlignment(2) = 0
        End If
        .Rows = 1
    End With
    If Not rsADOObject.EOF Then
        While Not rsADOObject.EOF
            strRow = rsADOObject(0)
            For intI = 1 To intJ
                strRow = strRow & vbTab & Trim(rsADOObject(intI))
            Next intI
            If rsADOObject(1) = "TDM_View_Filename" Then
                Text1 = IIf(IsNull(rsADOObject(2)), "", rsADOObject(2))
            End If
            FLX.AddItem strRow
            rsADOObject.MoveNext
        Wend
        rsADOObject.Close
    End If

fnGetData_Exit:
    Screen.MousePointer = vbNormal
    Set rsADOObject = Nothing
    Exit Sub
fnGetData_Error:
    LogErrorMsg Err, Error, "fnGetData", "", False
    GoTo fnGetData_Exit
End Sub

Private Sub fnSetData()
    On Error GoTo fnSetData_Error
    Dim strSQL As String

    Screen.MousePointer = vbHourglass
    strSQL = "UPDATE BUSINESS_OBJECT_LONG_STRING_ATTRIBUTE SET [VALUE] = '"
& Text1.Text & "' WHERE OID = '" & Label6.Caption & "' AND ATTRIBUTE_NAME =
'TDM_View_Filename'"
    curMatrixDB.Execute strSQL, 0

fnSetData_Exit:
    Screen.MousePointer = vbNormal
    Exit Sub
fnSetData_Error:
    LogErrorMsg Err, Error, "fnSetData", "", False
    GoTo fnSetData_Exit
End Sub

Public Sub fnGetSQLData(FLX As MSFlexGrid)
    On Error GoTo fnGetSQLData_Error
    Dim rsADOOMatrix As ADODB.Recordset
    Dim strSQL As String
    Dim strRow As String
    Dim intI As Integer
    Dim intJ As Integer
    Dim strSplit() As String

    Screen.MousePointer = vbHourglass
    If Trim(gstrInput) = "" Then
      If Trim(Text2) <> "" And Trim(Text3) <> "" Then
         If Not IsNumeric(Trim(Text3)) = True Then
            MsgBox "Please enter a Numeric Value in to the second text box",
vbOKOnly + vbCritical, "Numeric Value"
            GoTo fnGetSQLData_Exit
         End If
         strSQL = "tdm_MatrixChanges '" & Text2 & "'," & Text3 & ""
      Else
         strSQL = "tdm_MatrixChanges 'FULL', 0"
      End If
    Else
      strSplit = Split(gstrInput, ",")
      If UCase(Trim(strSplit(0))) = "FULL" Then
        strSQL = "tdm_MatrixChanges 'FULL',0"
      Else
        strSQL = "tdm_MatrixChanges '" & strSplit(0) & "', " & strSplit(1) &
""
      End If
    End If
    Set rsADOOMatrix = curSQLDB.Execute(strSQL)
    If Not rsADOOMatrix.EOF Then
        intJ = rsADOOMatrix.Fields.Count - 1
        FLX.Rows = 0
        FLX.Cols = intJ + 1
        strRow = rsADOOMatrix.Fields(0).Name
        For intI = 1 To intJ
            strRow = strRow & vbTab & rsADOOMatrix(intI).Name
        Next intI
        With FLX
            .AddItem strRow
            .Rows = 2
            .FixedRows = 1
            .Rows = 1
            .ColWidth(0) = 1000
            .ColWidth(1) = 2500
            .ColWidth(3) = 4380
            .ColWidth(5) = 1200
            .ColWidth(6) = 690
            .ColAlignment(0) = 0
            .ColAlignment(1) = 0
            .ColAlignment(4) = 0
            .ColAlignment(6) = 0
        End With
        While Not rsADOOMatrix.EOF
            strRow = rsADOOMatrix(0)
            For intI = 1 To intJ
                strRow = strRow & vbTab & Trim(rsADOOMatrix(intI))
            Next intI
            FLX.AddItem strRow
            rsADOOMatrix.MoveNext
        Wend
        Label8.Caption = "Total Netchange Records: " & FLX.Rows - 1
        LogErrorMsg 9990, "Total Netchange Records: " & FLX.Rows - 1,
"fnGetSQLData", "", False
        rsADOOMatrix.Close
        Me.cmdUpLoad.Enabled = True
    End If

fnGetSQLData_Exit:
    Screen.MousePointer = vbNormal
    Set rsADOOMatrix = Nothing
    Exit Sub
fnGetSQLData_Error:
    LogErrorMsg Err, Error, "fnGetSQLData", "", False
    GoTo fnGetSQLData_Exit
End Sub

Public Function fnUpdateMatrix(OID As String, sParam As String, sValue As
String) As Boolean
    On Error GoTo fnUpdateMatrix_Error
    Dim strSQL As String

    strSQL = "UPDATE BUSINESS_OBJECT_LONG_STRING_ATTRIBUTE SET [VALUE] = '"
& sValue & "' WHERE OID = '" & OID & "' AND ATTRIBUTE_NAME = '" & sParam & "'"
    curMatrixDB.Execute strSQL, 0
    If curMatrixDB.RecordsAffected > 0 Then
      fnUpdateMatrix = True
    Else
      fnUpdateMatrix = False
    End If

fnUpdateMatrix_Exit:
    Exit Function
fnUpdateMatrix_Error:
    LogErrorMsg Err, Error, "fnUpdateMatrix", "", False
    fnUpdateMatrix = False
    GoTo fnUpdateMatrix_Exit
End Function

Public Function fnLoopNetChange() As Boolean
    On Error GoTo fnLoopNetChange_Error
    Dim intI As Long
    Dim strSQL As String
    Dim rsADOMtxObject As Recordset
    Dim blRet As Boolean
    Dim intJ As Long
    Dim intRows As Long
    Dim intZ As Long
    Dim startTime As Date
    Dim blFirst As Boolean
    Dim blSuccess As Boolean

    startTime = Date & " " & Time
    Label10.Caption = "Time Started: " & startTime
    With flxTDM
        intJ = 1
        intI = 1
        intZ = 0
        intRows = .Rows - 1
        LogErrorMsg 9991, "Started Looping Through Netchange Table",
"fnLoopNetChange", "", False
comeHERE:
        intJ = intI
        For intI = intJ To .Rows - 1
            If cmdCancel.Enabled = True Then
                intZ = intZ + 1
                Label9.Caption = "Processing " & "(" & .TextMatrix(intI, 1)
& ") " & intZ & "/" & intRows & "..."
                .RowSel = intI
                .ColSel = .Cols - 1
                strSQL = "SELECT * FROM BUSINESS_OBJECT WHERE NAME = '" &
UCase(Trim(.TextMatrix(intI, 1))) & "'  AND REVISION =  '" &
UCase(Trim(.TextMatrix(intI, 2))) & "'"
                Set rsADOMtxObject = curMatrixDB.OpenRecordset(strSQL,
dbOpenDynaset)
                'If UCase(Trim(.TextMatrix(intI, 1))) = "22B18" Then Stop
                If Not rsADOMtxObject.EOF Then
                    blFirst = True
                    While Not rsADOMtxObject.EOF
                        DoEvents
                        If fnUpdateMatrix(rsADOMtxObject("OID"),
"TDM_CAD_Server_ID", .TextMatrix(intI, 4)) = True Then
                            If fnUpdateMatrix(rsADOMtxObject("OID"),
"TDM_State", .TextMatrix(intI, 5)) = True Then
                                If fnUpdateMatrix(rsADOMtxObject("OID"),
"TDM_View_Filename", .TextMatrix(intI, 3)) = True Then
                                    If fnUpdateMatrix(rsADOMtxObject("OID"),
"TDM_Version", .TextMatrix(intI, 6)) = True Then
                                       If blFirst = True Then
                                          If fnUpdateSQL(.TextMatrix(intI,
0), .TextMatrix(intI, 1), .TextMatrix(intI, 2), .TextMatrix(intI, 3),
..TextMatrix(intI, 4), .TextMatrix(intI, 5), 1, .TextMatrix(intI, 6)) = True
Then
                                             blFirst = False
                                             blSuccess = True
                                          End If
                                       End If
                                    Else
                                       Call fnUpdateSQL(.TextMatrix(intI,
0), .TextMatrix(intI, 1), .TextMatrix(intI, 2), .TextMatrix(intI, 3),
..TextMatrix(intI, 4), .TextMatrix(intI, 5), 0, .TextMatrix(intI, 6))
                                    End If
                                Else
                                    Call fnUpdateSQL(.TextMatrix(intI, 0),
..TextMatrix(intI, 1), .TextMatrix(intI, 2), .TextMatrix(intI, 3),
..TextMatrix(intI, 4), .TextMatrix(intI, 5), 0, .TextMatrix(intI, 6))
                                End If
                            Else
                                Call fnUpdateSQL(.TextMatrix(intI, 0),
..TextMatrix(intI, 1), .TextMatrix(intI, 2), .TextMatrix(intI, 3),
..TextMatrix(intI, 4), .TextMatrix(intI, 5), 0, .TextMatrix(intI, 6))
                            End If
                        Else
                            Call fnUpdateSQL(.TextMatrix(intI, 0),
..TextMatrix(intI, 1), .TextMatrix(intI, 2), .TextMatrix(intI, 3),
..TextMatrix(intI, 4), .TextMatrix(intI, 5), 0, .TextMatrix(intI, 6))
                        End If
                        rsADOMtxObject.MoveNext
                    Wend
                    If blSuccess = True Then
                        blSuccess = False
                        If .Rows > 2 Then
                            .RemoveItem (intI)
                            GoTo comeHERE
                        Else
                            .Rows = 1
                            Me.cmdUpLoad.Enabled = False
                        End If
                    End If
                End If
                Set rsADOMtxObject = Nothing
                DoEvents
            Else
                GoTo cmdCancel
                Label9.Caption = "Processed " & intZ & "/" & intRows & "..."
            End If
        Next intI
        Label9.Caption = "Processed " & intRows & "/" & intRows & "..."
cmdCancel:
        Label10.Caption = Label10.Caption & "--Time Ended: " & Date & " " &
Time
    End With
    'rsADOMtxObject.Close
    LogErrorMsg 9992, "Ended Looping Through Netchange Table",
"fnLoopNetChange", "", False

fnLoopNetChange_Exit:
    Set rsADOMtxObject = Nothing
    Exit Function
fnLoopNetChange_Error:
    LogErrorMsg Err, Error, "fnLoopNetChange", "", True
    GoTo fnLoopNetChange_Exit
End Function

Public Function fnUpdateSQL(itemID As String, itemPartNumber As String,
itemRevision As String, itemViewFileName As String, itemRegisteredID As
String, itemStateName As String, uploadStatus As Integer, itemVersion As
String) As Boolean
    On Error GoTo fnUpdateSQL_Error
    Dim strSQL As String

    strSQL = "tdm_MatrixHistory " & itemID & ", '" & itemPartNumber & "', '"
& itemRevision & "', '" & itemViewFileName & "', " & itemRegisteredID & ", '"
& itemStateName & "', " & itemVersion & ", " & uploadStatus & ", '" &
gEventID & "'"
    curSQLDB.Execute (strSQL)
    fnUpdateSQL = True

fnUpdateSQL_Exit:
    Exit Function
fnUpdateSQL_Error:
    LogErrorMsg Err, Error, "fnUpdateSQL", "", False
    fnUpdateSQL = False
    GoTo fnUpdateSQL_Exit
End Function

Private Sub Form_Load()
    gstrInput = Command$()
    Call fnSQLDBConnect
    Call fnMatrixDBConnect
    If gstrInput <> "" Then
        Load fmMain
        With fmMain
            .cmdCancel.Enabled = True
            .Visible = False
            LogErrorMsg 1111, "getting SQL Data", "form_load", "", False
            Call .fnGetSQLData(.flxTDM)
            If .flxTDM.Rows > 0 Then
               Call .fnLoopNetChange
            End If
            Call .Form_Unload(True)
            End
        End With
    Else
        fmMain.Visible = True
    End If
End Sub

Private Sub Form_Terminate()
   Call Form_Unload(True)
End Sub

Public Sub Form_Unload(Cancel As Integer)
   LogErrorMsg 9998, "Session Ended", "App Exit", "", False
   curSQLDB.Close
   Set curSQLDB = Nothing
   End
End Sub


Here's the module...........................................................

Option Explicit

Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal
lpBuffer As String, nSize As Long) As Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Public curSQLDB As ADODB.Connection
Public curMatrixDB As Database
Public gUserID As String
Public gComputerName As String
Public gstrConnectMatrix As String
Public gstrConnectSQL As String
Public gstrInput As String
Public gEventID As String

Public Function fnMatrixDBConnect() As Boolean
    On Error GoTo fnMatrixDBConnect_Error
    Dim strSQL As String
    Dim strErr As Long
    Dim strAlias As String

    gstrConnectMatrix = "DSN=MatrixOne, Inc." ';UID=XXXXX;PWD=XXXXX"
    Set curMatrixDB = OpenDatabase("", False, False, gstrConnectMatrix)
    With curMatrixDB
       .QueryTimeout = 9000
    End With
    fmMain.Label11.Caption = gstrConnectMatrix
    fnMatrixDBConnect = True

fnMatrixDBConnect_Exit:
    Exit Function
fnMatrixDBConnect_Error:
    fmMain.Label11.Caption = "DSN!=MatrixOne, Inc."
    fnMatrixDBConnect = False
    strErr = Err
    LogErrorMsg strErr, Error, "fnMatrixDBConnect", "", False
    Err.Clear
    GoTo fnMatrixDBConnect_Exit
End Function

Function fnAPIGetUsername() As Boolean
    On Error GoTo fnAPIGetUsername_Error
    Dim strUserID As String
    Dim vRet
    Dim intI As Integer

    strUserID = String$(50, " ")
    vRet = GetUserName(strUserID, 8)
    gUserID = UCase(Mid(Trim(strUserID), 1, 6))
    If Trim(gUserID) = "" Then
        GoTo fnAPIGetUsername_Exit
    Else
        For intI = 1 To Len(gUserID)
            If Asc(Mid(gUserID, intI, 1)) < 48 Then
                gUserID = Mid(gUserID, 1, intI - 1)
            End If
        Next intI
    End If
    fnAPIGetUsername = True

fnAPIGetUsername_Exit:
    Exit Function
fnAPIGetUsername_Error:
    LogErrorMsg Err, Error, "fnAPIGetUsername", "", False
    GoTo fnAPIGetUsername_Exit
End Function


Public Sub LogErrorMsg(ErrorNumber As Long, ErrorDescription As String,
ErrorLocation As String, CustomMessage As String, DoIDisplay As Boolean)
    On Error GoTo LogErrorMsg_Error
    Dim strErrMsg As String
    Dim strSQL As String

    DoEvents
    If CustomMessage <> "" Then
        strErrMsg = "No: " & ErrorNumber & " .. Desc: " & ErrorDescription &
" Message: " & CustomMessage
    Else
        strErrMsg = "No: " & ErrorNumber & " .. Desc: " & ErrorDescription
    End If
    strErrMsg = Trim(Left(strErrMsg, 254))
    If DoIDisplay Then
        If CustomMessage <> "" Then
            Call ErrorNotify(ErrorNumber, ErrorDescription & " " &
CustomMessage, ErrorLocation)
        Else
            Call ErrorNotify(ErrorNumber, ErrorDescription, ErrorLocation)
        End If
    Else
        strSQL = "tdm_LogEvent '" & App.ProductName & " " & App.Major & "."
& App.Minor & "', '" & gComputerName & "', '" & gUserID & "','" &
ErrorLocation & "','" & ErrorNumber & "', '" & ErrorDescription & "', '" &
gEventID & "'"
        curSQLDB.Execute (strSQL)
    End If

LogErrorMsg_Exit:
    Exit Sub
LogErrorMsg_Error:
    GoTo LogErrorMsg_Exit
End Sub

Public Sub ErrorNotify(ErrNo, errorDesc As String, ErrLocation As String)

    MsgBox "Error Number: " & ErrNo & vbCrLf & vbCrLf & "Error Description:
" & errorDesc & vbCrLf & vbCrLf & "Error Location: " & ErrLocation & vbCrLf &
vbCrLf & "Please contact your System Administrator to resolve the Error...",
vbOKOnly + vbCritical, "Error in " & ErrLocation

End Sub

Function fnAPIGetComputerName() As Boolean
    On Error GoTo fnAPIGetComputerName_Error
    Dim lstrComputerName As String
    Dim lngLength As Long
    Dim lngResult As Long

    lngLength = 50
    lstrComputerName = String$(lngLength, 0)
    lngResult = GetComputerName(lstrComputerName, lngLength)
    gComputerName = Left(lstrComputerName, InStr(1, lstrComputerName,
Chr(0)) - 1)
    gEventID = gUserID & gComputerName & Format(Date, "MMDDYYYY") &
Format(Time, "HHMMSS")
    fnAPIGetComputerName = True

fnAPIGetComputerName_Exit:
    Exit Function
fnAPIGetComputerName_Error:
    fnAPIGetComputerName = False
    Call ErrorNotify(Err, Error, "fnAPIGetComputerName")
    Err.Clear
    GoTo fnAPIGetComputerName_Exit
End Function

Public Function fnSQLDBConnect() As Boolean
    On Error GoTo fnSQLDBConnect_Error
    Dim strSQL As String
    Dim strErr As Long

    If fnAPIGetUsername = True Then
        Call fnAPIGetComputerName
        gstrConnectSQL = "Provider=sqloledb;Data Source=" & "XXXXXXX" &
";Initial Catalog=" & "IDEASTDM" & ";User Id=" & "XXXXXXX" & ";Password=" &
"XXXXXXX" & ";"
        Set curSQLDB = New ADODB.Connection
        With curSQLDB
            .ConnectionString = gstrConnectSQL
            .CommandTimeout = 180
            .Open
        End With
        LogErrorMsg 9999, "Session Started - " & gstrInput,
"fnSQLDBConnect", "", False
        fnSQLDBConnect = True
    Else
        LogErrorMsg 999, "No Connection to the SQL Server.",
"fnSQLDBConnect", "", True
        End
    End If

fnSQLDBConnect_Exit:
    Exit Function
fnSQLDBConnect_Error:
    fnSQLDBConnect = False
    strErr = Err
    LogErrorMsg Err, Error, "fnSQLDBConnect", "", False
    If strErr = -2147217843 Or strErr = -2147467259 Or strErr = -2147217865
Then
        End
    End If
    Err.Clear
    GoTo fnSQLDBConnect_Exit
End Function


I blocked out any server names, ids and passwords to protect the
innocent........

I really appreciate your suggestions/input............Thanks.

Help with disconnected recordset!
question -- close adodb connection inside dll
Hidden treasures...
CommonDialog sets Windows Default Printer - is Mike Williams out there?
Comparing UDTs
click on a menu
error making function call with multiple parameters to dll
ADODB Recordsets into Array
WebBrowser vs Pdf.ocx
Error creating Oracle object