create a mshflexgrid file in vb6 if missing

isnoend2001
isnoend2001 used Ask the Experts™
on
i have a reminder program that uses a Mshflexgrid. On first load it does not exist and gives an error.
how can it be created if it does not exist ?
flexgridFor-EE.zip
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
That's not hard to do and I'll get on it now.

Author

Commented:
OK, thanks
Older than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
Lines 16 and 27 to 50 are new. This creates a dat file with a "Delay" column at the end.

Private Sub LoadData(grdName As MSHFlexGrid)

Dim file_name As String
Dim fnum As Integer
Dim max_row As Integer
Dim max_col As Integer
Dim r As Integer
Dim C As Integer
Dim txt As String
'******* Q28899179B Start *******
Dim dblMins As Double
Dim strParts() As String
Dim lngPart As Long
Dim strReminders() As String
'******* Q28899179B End *********
Const QUOTE = """"

'******* Q28901272G Start *******
'    file_name = gGridFolder
    file_name = App.Path & gGridFolder
'******* Q28901272G End *********
    If Right$(file_name, 1) <> "\" Then file_name = _
        file_name & "\"
    file_name = file_name & "FlexGrid.dat"

    fnum = FreeFile
    On Error Resume Next
    Open file_name For Input As fnum
    If Err.Number = 53 Then ' File not found
        If vbNo = MsgBox("FlexGrid.dat not found. Create it?", vbCritical + vbYesNo, "FlexGrid.dat Missing") Then
            Unload Me
            End
            Exit Sub
        End If
        Open App.Path & gGridFolder & "\FlexGrid.dat" For Output As #fnum
        Print #fnum, "0,8"
        Print #fnum, QUOTE & "File Name" & QUOTE & "," _
                   & QUOTE & "Entry Date" & QUOTE & "," _
                   & QUOTE & "Reminder Description" & "," _
                   & QUOTE & "Time/Date" & QUOTE & "," _
                   & QUOTE & "Reminder Type" & QUOTE & "," _
                   & QUOTE & "Next Reminder" & QUOTE & "," _
                   & QUOTE & "Open" & QUOTE & "," _
                   & QUOTE & "Delete" & QUOTE & "," _
                   & QUOTE & "Delay" & QUOTE & ","
        Close
        Open file_name For Input As fnum
    End If
    
    On Error GoTo 0

    ' Hide the control until it's loaded.
    grdName.Visible = False
    DoEvents

    ' Get the maximum row and column.
    Input #fnum, max_row, max_col

    grdName.FixedCols = 0
    grdName.Cols = max_col + 1
    grdName.Rows = max_row + 1

    '******* Q28899179B Start *******
    ReDim strReminders(0 To max_row, 0 To max_col)
    '******* Q28899179B End *********

    ' Load the cell entries into the array
    For r = 0 To max_row
        For C = 0 To max_col
            Input #fnum, txt
            '******* Q28899179B Start *******
            'grdName.TextMatrix(r, c) = txt
            strReminders(r, C) = txt
            If C = GRD_DELAY Then
                '******* Q28900024I Start *******
                If r > 0 Then
                    ' Update the next reminder values at startup so that
'                   ' they reflect the comparison with today's date
                    '******* Q28901272D Start *******
'                    strReminders(r, GRD_NEXT_REMINDER) = DetermineNextTaskTime(strReminders(r, GRD_TIME_DATE))
                    If InStr(strReminders(r, GRD_TIME_DATE), ":") > 0 Then
                        strReminders(r, GRD_NEXT_REMINDER) = DetermineNextTaskTime(strReminders(r, GRD_TIME_DATE), "Dy")
                    Else
                        ' The second part of this extracts, for example "wk" from the file name contained in col 0
                        strParts = Split(strReminders(r, GRD_FILE_NAME), "\")
                        strReminders(r, GRD_NEXT_REMINDER) = DetermineNextTaskTime(strReminders(r, GRD_TIME_DATE), _
                                                             Left$(strParts(UBound(strParts)), 2))
                    '******* Q28901272D End *********
                    End If
                End If
                '******* Q28900024I End *********
                '******* QQ28904261A Start *******
'                strParts = Split(strReminders(r, GRD_NEXT_REMINDER), " ")
'                dblMins = 0
'                For lngPart = 1 To UBound(strParts) Step 2
'                    If strParts(lngPart) = "Days" Then
'                        dblMins = dblMins + strParts(lngPart - 1) * 1440
'                    End If
'                    If strParts(lngPart) = "Hours" Then
'                        dblMins = dblMins + strParts(lngPart - 1) * 60
'                    End If
'                    If strParts(lngPart) = "Minutes" Then
'                        dblMins = dblMins + strParts(lngPart - 1)
'                    End If
'                Next
'                strReminders(r, GRD_DELAY) = dblMins
                If r > 1 And strReminders(r, GRD_DELAY) <> "" Then
                    If DateDiff("d", strReminders(r, GRD_DELAY), Format(Now, "mm/dd/yyyy h:mm AM/PM")) <> 0 Then
                        ' Clear yesterday's (or previous) delay values
                        strReminders(r, GRD_DELAY) = ""
                        mbGridIsDirty = True
                    End If
                End If
                '******* QQ28904261A End *********
                
            End If
            '******* Q28899179B End *********
        Next C
        ' Read the last blank entry.
        Input #fnum, txt
    Next r

    Close #fnum
    
    '******* Q28899179B Start *******
    QuickSortArray strReminders, 1, , 8
    ' Fill the grid
    With grdName
        For r = 0 To max_row
            For C = 0 To max_col
                .TextMatrix(r, C) = strReminders(r, C)
            Next
        Next
    End With
    
    '******* Q28901843F Start *******
    CoverBlankRows
    '******* Q28901843F End *********
'    '******* Q28899179B End *********
    '******* Q28899508B Start *******
    ColorNonEditColumns
    '******* Q28899508B End *********
    ' Display the control.
    grdName.Visible = True
    
    '******* Q28900024Z Start *******
    AdjustWidth
    '******* Q28900024Z End *********
    
    mintgridMasterCurRow = 0
    mintgridMasterCurCol = 0
End Sub

Open in new window

Author

Commented:
Good job, Thanks

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial