INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

How to connect using App.path w/ MS Chart VB6 database

How to connect using App.path w/ MS Chart VB6 database

(OP)
I'm programming a running journal vb6 database program and what to use MS Chart along other forms.  I used the Data Form Wizard for the MS Chart...ADO code.
X-Axis-Date
Y-Axis-Distance
Chart Style: 2D Bar
My database is: running2009.mdb

I want to use App.path & "\running2009.mdb" to open the database so the program can be used on other computers (I'm a track coach and making it for my runners).

When I amend the code, used by the Wizard, I can't get the chart to display correctly.

Can someone help?

Below is the code used by the Data Wizard:

Option Explicit


Private Const MARGIN_SIZE = 60 'In Twips
Private Const SHAPE_COMMAND = "SHAPE {select Date,Distance from february2009 Order by Date} AS ChildCommand COMPUTE ChildCommand, SUM(ChildCommand.[Distance]) AS [Distance] BY [Date]"
Private Const CONNECT_STRING = "PROVIDER=MSDataShape;Data Source=C:\Documents and Settings\HomeComputer\Desktop\CurrentProject\running2009.mdb;Data Provider=Microsoft.Jet.OLEDB.4.0"
Private Const FIELD_X = "Date"
Private Const FIELD_Y = "Distance"
Private Const FIELD_Z = ""
Private Const VBERR_INVALID_PROCEDURE_CALL = 5
Private Const MARKERS_VISIBLE = 0
Private Const BRACKET_LEFT = "["
Private Const BRACKET_RIGHT = "]"
Private Const SPACE_CHAR = " "

Private Sub cmdClose_Click()
    Unload Me
End Sub

'-------------------------------------------------------------------------
'Purpose:   Display an error message to the user
'In:
'   [oError]
'           Error object containing error information
'-------------------------------------------------------------------------
Private Sub DisplayError(oError As ErrObject)
    MsgBox oError.Description, vbExclamation, App.Title
End Sub

Private Sub Form_Load()
    Dim conShape As ADODB.Connection
    Dim recShape As ADODB.Recordset
    
    On Error GoTo Form_Load_Error
    'Create and open connection to the Data Shape provider
    Set conShape = New ADODB.Connection
    conShape.Open CONNECT_STRING
    'Create and open a recordset
    Set recShape = New ADODB.Recordset
    recShape.Open SHAPE_COMMAND, conShape
    'Fill the chart with the recordset data
    ShowRecordsInChart recShape, FIELD_X, FIELD_Y, FIELD_Z
    'Show or hide markers
    ShowMarkers MARKERS_VISIBLE
    Exit Sub
Form_Load_Error:
    DisplayError Err
    Exit Sub
End Sub

Private Sub Form_Resize()
    Dim sngButtonTop As Single
    Dim sngScaleWidth As Single
    Dim sngScaleHeight As Single
    
    On Error GoTo Form_Resize_Error
    With Me
        sngScaleWidth = .ScaleWidth
        sngScaleHeight = .ScaleHeight
        'Move Close button to the lower right corner
        With .cmdClose
            sngButtonTop = sngScaleHeight - (.Height + MARGIN_SIZE)
            .Move sngScaleWidth - (.Width + MARGIN_SIZE), sngButtonTop
        End With
        .chtReport.Move MARGIN_SIZE, _
                        MARGIN_SIZE, _
                        sngScaleWidth - (2 * MARGIN_SIZE), _
                        sngButtonTop - (2 * MARGIN_SIZE)
    End With
    Exit Sub
Form_Resize_Error:
    'An error will occur if the user sizes
    'the form so small that negative heights
    'or widths are calculated
    Resume Next
End Sub

'-------------------------------------------------------------------------
'Purpose:   Determines if the passed key is being used in the
'           passed collection.
'In:
' [cCol]    The collection to check for key use in.
' [sKey]    The key to look for.
'Return:    If the key is being used by the collection, true
'           is returned.  Otherwise, false is returned.
'-------------------------------------------------------------------------
Private Function IsKeyInCollection(cCol As Collection, sKey As String) As Boolean
    Dim v As Variant
    On Error Resume Next
    v = cCol.Item(sKey)
    'It is important to check for error 5, rather than checking for
    'any error, because an error could occur even if the key is valid.
    'If the key existed, but it was associated with an element that
    'was an object, an error would occur because 'Set' wasn't used
    'to assign it to 'v'.
    IsKeyInCollection = (Err.Number <> VBERR_INVALID_PROCEDURE_CALL)
    Err.Clear
End Function

'----------------------------------------------------------
'Purpose:   Shows or Hides series markers, according to the
'           parameter.
'In:
' [bShow]   If true, all the series markers will be shown.
'           Otherwise, all the series markers will be hidden.
'----------------------------------------------------------
Private Sub ShowMarkers(bShow As Boolean)
    Dim i As Long
    On Error GoTo ShowMarkers_Click_Error
    With chtReport.Plot
        For i = 1 To .SeriesCollection.Count
            .SeriesCollection(i).SeriesMarker.Show = bShow
        Next
    End With
    Exit Sub
ShowMarkers_Click_Error:
    DisplayError Err
    Exit Sub
End Sub

'----------------------------------------------------------
'Purpose:   Displays the data summarized in the passed recordset
'           in the Chart.
'In:
' [recParent]
'           A recordset created using a Shape command, that
'           groups by one or two fields, and summarizes one.
' [sFldX]
'           The name of the field to group by on the X axis.
' [sFldY]
'           The name of the field to summarize on the Y axis.
' [sFldZ]
'           The name of the field to group by on the Z axis. This
'           field should be a zero length string, if the recordset
'           only groups by one field.
'----------------------------------------------------------
Private Sub ShowRecordsInChart(recParent As Recordset, _
                               sFldX As String, _
                               sFldY As String, _
                               sFldZ As String)
                                   
    Dim bUseZ As Boolean
    Dim cRows As Collection
    Dim cCols As Collection
    Dim lCol As Long
    Dim lRow As Long
    Dim lMaxCol As Long
    Dim lMaxRow As Long
    Dim sValue As String
    
    On Error GoTo ShowRecordsInChart_Error
    If Len(sFldZ) = 0 Then bUseZ = False Else bUseZ = True
    
    Set cRows = New Collection
    Set cCols = New Collection
    
    With Me.chtReport
        'Turn off chart painting
        .Repaint = False
        With .DataGrid
            'Clear the chart
            .DeleteRows 1, .RowCount
            .DeleteColumns 1, .ColumnCount
            .DeleteColumnLabels 1, .ColumnLabelCount
            .DeleteRowLabels 1, .RowLabelCount
            'Make sure there is one level of labels
            .InsertColumnLabels 1, 1
            .InsertRowLabels 1, 1
            'If the Z axis is not being used, make
            'sure there is one column
            If Not bUseZ Then .InsertColumns 1, 1
            recParent.MoveFirst
            Do Until recParent.EOF
                'Make sure a row is added for this X field
                sValue = FixNull(recParent.Fields(sFldX).Value, False)
                If Not IsKeyInCollection(cRows, sValue) Then
                    lMaxRow = lMaxRow + 1
                    lRow = lMaxRow
                    'Store the row index associated with
                    'the Row name
                    cRows.Add lRow, sValue
                    .InsertRows lRow, 1
                    .RowLabel(lRow, 1) = sValue
                Else
                    lRow = cRows.Item(sValue)
                End If
                
                'Make sure a column is added for this Z field
                If bUseZ Then
                    sValue = FixNull(recParent.Fields(sFldZ).Value, False)
                    If Not IsKeyInCollection(cCols, sValue) Then
                        lMaxCol = lMaxCol + 1
                        lCol = lMaxCol
                        'Store the column index associated with
                        'the column name
                        cCols.Add lCol, sValue
                        .InsertColumns lCol, 1
                        .ColumnLabel(lCol, 1) = sValue
                    Else
                        lCol = cCols.Item(sValue)
                    End If
                    'Set the datapoint value for this record's row and column
                    .SetData lRow, lCol, FixNull(recParent.Fields.Item(sFldY).Value, True), 0
                Else
                    'Set the datapoint value for this record's row
                    'There is only one column in this case
                    .SetData lRow, 1, FixNull(recParent.Fields.Item(sFldY).Value, True), 0
                End If
                'Move the recordset to the next record
                recParent.MoveNext
            Loop
        End With
        'Turn painting back on
        .Repaint = True
    End With
    Exit Sub
ShowRecordsInChart_Error:
    'Make sure the charts painting is turned back on
    Me.chtReport.Repaint = True
    DisplayError Err
    Exit Sub
End Sub

'-------------------------------------------------------------------------
'Purpose:   Checks a variant value for null.  If the value is null, returns
'           a vbNullString or a zero.
'In:
' [vField]
'           The variant to check for null.
' [bNumericRequired]
'           If true, return 0 if the variant is null.  Otherwise, return
'           vbNullString.
'-------------------------------------------------------------------------
Private Function FixNull(vField As Variant, _
                        bNumericRequired As Boolean) As Variant
    If IsNull(vField) Then
        If bNumericRequired Then
            FixNull = 0
        Else
            FixNull = vbNullString
        End If
    Else
        FixNull = vField
    End If
End Function


 

RE: How to connect using App.path w/ MS Chart VB6 database

You want to change CONNECT_STRING from a constatnt to a variable and then set the value of the variable in Form_Load before you open the connection, e.g.

CODE

Dim CONNECT_STRING As String

Private Sub Form_Load()
    Dim conShape As ADODB.Connection
    Dim recShape As ADODB.Recordset
    
    On Error GoTo Form_Load_Error
    'Create and open connection to the Data Shape provider
    CONNECT_STRING = App.Path & "\running2009.mdb"
    Set conShape = New ADODB.Connection
    conShape.Open CONNECT_STRING
    ...
Hope this helps

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

RE: How to connect using App.path w/ MS Chart VB6 database

*cough*

Ignore some of that post (it's a bit early in the day for me wink)

The connection string should be set like this:

CODE

CONNECT_STRING = "PROVIDER=MSDataShape;Data Source=" & App.Path & "\running2009.mdb;Data Provider=Microsoft.Jet.OLEDB.4.0"
Hope this actually helps smile

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

RE: How to connect using App.path w/ MS Chart VB6 database

(OP)
Thank you very much!

I had to change a couple more things but without your instructions I would never made it!!

Form Load should look like this to work...at least good enough for me...thank you again HarleyQuinn


Private Sub Form_Load()

Dim conShape As ADODB.Connection
    Dim recShape As ADODB.Recordset
    
    On Error GoTo Form_Load_Error
    'Create and open connection to the Data Shape provider
    CONNECT_STRING = "PROVIDER=MSDataShape;Data Source=" & App.Path & "\running2009.mdb;Data Provider=Microsoft.Jet.OLEDB.4.0"
    Set conShape = New ADODB.Connection
    conShape.Open CONNECT_STRING
    Set recShape = New ADODB.Recordset
    recShape.Open SHAPE_COMMAND, conShape
    ShowRecordsInChart recShape, FIELD_X, FIELD_Y, FIELD_Z
    'Show or hide markers
    ShowMarkers MARKERS_VISIBLE
    
    Exit Sub
   
Form_Load_Error:
    DisplayError Err
    
    Exit Sub

RE: How to connect using App.path w/ MS Chart VB6 database

Glad I could help smile

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close