I have two virtually identical PCs, each running XP with all current updates.
Both are running identical copies of a VB6 executable, compiled with Visual
Studio Enterprise Edition.  The application reads an excel file with 9
columns and displays it in a datagrid bound to a ADO data control)  On PC#1
all 9 columns appear as expected.  On PC#2, only two column headings are
displayed and no rows appear in the datagrid.  If I select a process command
button on the form, it appears that both PC's have read the file correctly.

There is obviously something different about the two PC configurations, but
WHAT?  I downloaded the current VB6 runtime components on both machines, with
no effect.

Any insight into this problem will be greatly appreciated.

KenGrover,

Rather than leaving the post unanswered, can you post some sample code to
see where the problem could arise on the different pcs.

Alastair MacFarlane

Show quoteHide quote

OK, here is a bunch of code.  (Sorry if this is way too much) Note that the
problem seems to be in

        Sub pInitializeGrid

'******************************************************

Private mrst         As New ADODB.Recordset

'******************************************************

Private Sub cmdOpen_Click()
Dim strFilePath As String
    '
    ' Let user locate the Excel file.
    '
    strFilePath = App.Path
    If Not fOpenFile(strFilePath, "*.xls", "Excel Data") Then
        GoTo NormalExit
    End If

    '
    ' Load it into the grid.
    '
    Call pLoadExcelData(strFilePath)

NormalExit:
End Sub

'******************************************************


Private Function fOpenFile(ByRef strPath As String, _
        ByVal strFilter As String, ByVal strTitle As String) As Boolean

    '
    ' Let the user point to a file.
    '
    On Error GoTo ErrorHandler
    fOpenFile = True
    strPath = ""

    '
    ' Display the file open dialog.
    '
    With CommonDialog
       .FileName = ""
       .CancelError = True
       .DialogTitle = "Select the " & strTitle & " file"
       .DefaultExt = ""
       .Flags = cdlOFNFileMustExist Or cdlOFNNoLongNames Or
cdlOFNPathMustExist Or cdlOFNHideReadOnly
       .Filter = strFilter & " |" & strFilter
       .FilterIndex = 1
       .ShowOpen
       strPath = UCase$(Trim$(.FileName))
    End With
    Exit Function

ErrorHandler:
    fOpenFile = False
End Function

'******************************************************


Private Sub pLoadExcelData(ByVal strXLSFile As String)
Dim strSQL      As String
Dim strError    As String
Dim strWkShName As String
Dim strConnect  As String
Dim strTemp     As String
Dim clsData     As New clsData
Dim rst         As ADODB.Recordset
Dim i           As Long


    On Error GoTo ErrorHandler

    Screen.MousePointer = vbHourglass
    lblStatus.Caption = "Reading Excel..."
    lblStatus.Refresh

    '
    ' Build the ADO connection string for the worksheet.
    '
    strConnect = "Provider=MSDASQL.1;Persist Security Info=False;Data
Source=Persi;DBQ=XXLSFILEX;DefaultDir=XXLSDIRX"
    strConnect = Replace$(strConnect, "XXLSFILEX", strXLSFile)
    strTemp = Mid$(strXLSFile, 1, InStrRev(strXLSFile, "\") - 1)
    strConnect = Replace$(strConnect, "XXLSDIRX", strTemp)

    clsData.XLSConnectString = strConnect

    '
    ' Connect to the Excel worksheet.
    '
    If Not clsData.XLSConnect(strError) Then
        GoTo ErrorHandler
    End If


    '
    ' Get the name of the first Excel worksheet.
    '
    If Not clsData.OpenSchema(rst, strError) Then
        GoTo ErrorHandler
    End If
    strWkShName = rst.Fields("Table_Name").Value


    '
    ' Build the SQL to retrieve the data
    ' from the Excel worksheet.
    '
    strSQL = "SELECT * FROM ""XWKSHTX"""
    strSQL = Replace$(strSQL, "XWKSHTX", strWkShName)

    '
    ' Retrieve the data.
    '
    If clsData.OpenRecordSet(strSQL, mrst, strError, False) = cSuccess Then
        '
        ' Bind it to the grid.
        '
        Set Adodc.Recordset = mrst
        '
        ' Disconnect from the database.
        '
        Set mrst.ActiveConnection = Nothing
        '
        ' Set up the grid.
        '
        i = 0
        mrst.MoveFirst
        Do While Not mrst.EOF
            If IsNull(mrst.Fields(0)) Then
                Exit Do
            Else
                i = i + 1
                mrst.MoveNext
            End If
        Loop

        lRecordCount = i

        nNumRecords = i

        mrst.MoveFirst

        Call pInitializeGrid
    Else
        GoTo ErrorHandler
    End If



    lblStatus.Caption = "Excel file: " & strXLSFile
    lblRows.Caption = "Records:"


    '******************************************************
    ' LBLCOUNT.CAPTION IS DISPLAYED CORRECTLY ON BOTH PC'S
    '******************************************************

    lblCount.Caption = i
    cmdContinue.Enabled = True

    GoTo NormalExit

ErrorHandler:
    lblStatus.Caption = ""
    strError = gclsErr.FormatErrorText(strError, "pLoadExcelData", "")
    On Error Resume Next

    Screen.MousePointer = vbDefault
    Call MsgBox(strError, vbCritical, "Error loading Excel Data.")

NormalExit:
    On Error Resume Next

    clsData.Disconnect
    Set clsData = Nothing

    If rst.State = adStateOpen Then rst.Close
    Set rst = Nothing

    Screen.MousePointer = vbDefault
End Sub


'******************************************************
' THE PROBLEM SEEMS TO BE IN THIS SUB:
'******************************************************

Private Sub pInitializeGrid()
Dim i       As Long
Dim strTemp As String

With DataGrid
    .AllowRowSizing = True
    .AllowAddNew = False
    .AllowDelete = False
    .AllowUpdate = False

    .ColumnHeaders = True
    .MarqueeStyle = dbgHighlightCell
    .RecordSelectors = True
    .RowHeight = 250
    .ScrollBars = dbgBoth

    '****************************************************
    ' COLUMNS.COUNT "APPEARS" TO BE SET TO ZERO ON THE PC
                '       THAT ISN'T WORKING RIGHT:
    '  (IT SHOULD BE 28)
    '****************************************************

        For i = 0 To .Columns.Count - 1
            .Columns.Item(i).Width = 1200
            .Columns(i).Locked = False
            .Columns(i).Visible = True
            .Columns(i).AllowSizing = True
            .Columns.Item(i).Caption = UCase$(Trim$(mrst.Fields(i).Name))
        Next

End With

End Sub



'******************************************************
' THE BALANCE OF THIS CODE IS PROBABLY NOT RELEVANT BUT I'LL INCLUDE IT
' IN CASE IT IS
'******************************************************


Public Function XLSConnect(ByRef strError As String) As Boolean
'
' Establish a connection to Excel.
'
Dim strADOErr As String

    '
    ' Connect to the database.
    '
    Set mcnn = New ADODB.Connection
    With mcnn
        .ConnectionString = XLSConnectString  'Connection string
        .CursorLocation = adUseClient         'Cursor location
        .ConnectionTimeout = 60               'Seconds to wait for a
connection
        .CommandTimeout = 120                 'Seconds to wait for a command
        .Errors.Clear                         'Clear the errors collection

        On Error Resume Next
        .Open
        On Error GoTo ErrorHandler

        If .State <> adStateOpen Then
            strError = "Unable to connect"
            If gclsErr.ADOError(mcnn) Then
                strADOErr = gclsErr.FormatADOErrorText(mcnn)
            End If
            GoTo ErrorHandler
        End If
    End With

    XLSConnect = True
    Exit Function

ErrorHandler:
    strError = gclsErr.FormatErrorText(strError, "XLSConnect", strADOErr)
End Function

'******************************************************



Public Function OpenSchema(ByRef rst As ADODB.Recordset, ByRef strError As
String) As Boolean
'
' Obtain database schema information.
' Specifically, the name of the tables
' (worksheets) in an Excel file.
'
Dim strADOErr As String

    '
    ' Connect to the database.
    '
    Set rst = New ADODB.Recordset

    mcnn.Errors.Clear
    On Error Resume Next
    Set rst = mcnn.OpenSchema(adSchemaTables)
    On Error GoTo ErrorHandler

    If rst.State <> adStateOpen Then
        strError = "Unable to retrieve database schema information"
        If gclsErr.ADOError(mcnn) Then
            strADOErr = gclsErr.FormatADOErrorText(mcnn)
        End If
        GoTo ErrorHandler
    End If


    If rst.EOF Then
        OpenSchema = False
        strError = "No schema data retrieved"
    Else
        rst.MoveFirst
        OpenSchema = True
    End If

    Exit Function

ErrorHandler:
    strError = gclsErr.FormatErrorText(strError, "OpenSchema", strADOErr)
End Function


'******************************************************


Public Function OpenRecordSet(ByVal strSQL As String, ByRef rst As
ADODB.Recordset, _
        ByRef strError As String, Optional blnReadOnly As Boolean = True) As
Long
'
' Given and SQL string, open a recordset
' to retrieve the data.
'
Dim strADOErr As String


    On Error GoTo ErrorHandler

    strError = ""
    '
    ' Retrieve the data into a recordset.
    '
    Set rst = New ADODB.Recordset

    With rst
        .CursorLocation = adUseClient

        If blnReadOnly Then
            .CursorType = adOpenStatic
        Else
            .CursorType = adOpenDynamic
        End If

        On Error Resume Next
        If blnReadOnly Then
            .Open strSQL, mcnn, , adLockReadOnly, adCmdText
        Else
            .Open strSQL, mcnn, , adLockOptimistic, adCmdText
        End If
        On Error GoTo ErrorHandler

        If .State <> adStateOpen Then
            strError = "Unable to retrieve data"
            If gclsErr.ADOError(mcnn) Then strADOErr =
gclsErr.FormatADOErrorText(mcnn)
            GoTo ErrorHandler
        End If

        If .EOF Then
            OpenRecordSet = eNoData
            strError = "No records retrieved"
        Else
            .MoveFirst
            OpenRecordSet = eSuccess
        End If


    End With

    GoTo NormalExit

ErrorHandler:
    On Error Resume Next
    strError = gclsErr.FormatErrorText(strError, "OpenRecordSet", strADOErr)
    OpenRecordSet = eError

NormalExit:
End Function

'******************************************************



Public Property Let XLSConnectString(ByVal strValue As String)

    mstrXLSConnectString = Trim$(strValue)

End Property

'******************************************************


Public Property Get XLSConnectString() As String

    XLSConnectString = mstrXLSConnectString

End Property

'******************************************************


Private Sub Class_Terminate()

    Call Disconnect

End Sub


'******************************************************


Public Sub Disconnect()
'
' Disconnect from the database.
'

    On Error Resume Next

    If mcnn.State = adStateOpen Then
        mcnn.Close
        Set mcnn = Nothing
    End If

End Sub



'******************************************************

Show quoteHide quote

Are there alternatives to using WIN32_Find_Data?
test for empty array?
VB6 Question
VB6 applications with SQL Server and Adobe
Runtime error 429
ADO Recordset Filter Problem
Best ways for reading and editing text files
OT: Blew away shortcut to desktop, How to replace it?? Windows 2000 Professional
How to implement Link List in VB 6.0?
VB Newbie