[RESOLVED] VB6/Jet database not showing data correctly

Hi there,

I' am currently in the process of launching a VB6 database that works in conjunction with Jet DAO (old-school I know).

The program basically operates as both a calendar, as well as a program that lists series.

The issue that we are currently experiencing is that on some computers the data being pulled from the database does not show up correctly, in that it will not list any information on certain weeks. This is only on some computers however! on others it works perfectly fine.

I have been exploring the possibility that this is a .dll issue. Do duplicate .dll's sometimes cause a program to behave wonky?

I can give you more information, or email code/screenshots if required.

Thanks for your help.

Michael

Based on what you have written, the most likely problem is mistakes in your code, particularly in relation to how Date based values are handled.

If you show us the relevant code (particularly the date based reading/writing) we can check it.

Code:

---

Private Sub Form_Load()

  Dim dteTemp As Date
  Dim i As Long


  m_lngRefreshLevel = 0
  m_blnFormInitialized = False


  ' Set caption shown in title bar
  Me.Caption = "Wellspring Program Registration Calendar"
 
  ' At start-up, set form to fullscreen mode
  Me.WindowState = vbMaximized
 
  ' Set form to new background colour
  fraScheduleMode.BackColor = picHeader.BackColor
  Me.BackColor = COLOR_BACKGROUND
 
  ' Initialize reference to UtilDB
  If m_objUtilDB Is Nothing Then
    Set m_objUtilDB = New clsUtilDB
    m_objUtilDB.Init
  End If
 
  m_objUtilDB.IsSeriesMode = True
  optScheduleMode(2).Value = True
 
  TwipsX = Screen.TwipsPerPixelX
  TwipsY = Screen.TwipsPerPixelY
 

  Me.KeyPreview = True
 
  picHeader.BackColor = COLOR_BACKGROUND
  fraScheduleMode.BackColor = COLOR_BACKGROUND
  optScheduleMode(0).BackColor = COLOR_BACKGROUND
  optScheduleMode(1).BackColor = COLOR_BACKGROUND
  optScheduleMode(2).BackColor = COLOR_BACKGROUND
 
  cmdPrev.BackColor = COLOR_BACKGROUND
  cmdNext.BackColor = COLOR_BACKGROUND
  cmdManageMembers.BackColor = COLOR_BACKGROUND
  cmdRegisterSeries.BackColor = COLOR_BACKGROUND
  cmdWaitList.BackColor = COLOR_BACKGROUND
  cmdManageSeries.BackColor = COLOR_BACKGROUND
  cmdSessionDetailsReport.BackColor = COLOR_BACKGROUND
  cmdAdminOptions.BackColor = COLOR_BACKGROUND
 
  shpScheduleBottomLeft.BackColor = COLOR_BACKGROUND
  shpScheduleBottomLeft.BorderColor = COLOR_BACKGROUND
  shpScheduleBottomRight.BackColor = COLOR_BACKGROUND
  shpScheduleBottomRight.BorderColor = COLOR_BACKGROUND
  shpScheduleTopRight.BackColor = COLOR_BACKGROUND
  shpScheduleTopRight.BorderColor = COLOR_BACKGROUND

  fraScheduleMode.BackColor = COLOR_BACKGROUND
 
  cboSASRange.Clear
  dteTemp = Int(DateSerial(2010, 1, 3))
  Do While dteTemp < Now() + 720
    cboSASRange.AddItem " week of " & Format(dteTemp, "Mmm DD, YYYY")
    cboSASRange.ItemData(cboSASRange.NewIndex) = Int(dteTemp)
    dteTemp = dteTemp + 7
  Loop
 
  dteTemp = Now()
  For i = 0 To cboSASRange.ListCount - 1
    If cboSASRange.ItemData(i) = Int(uWeekStart(dteTemp)) Then
      cboSASRange.ListIndex = i
      Exit For
    End If
  Next i
 
  m_objUtilDB.ScheduleRequery dteTemp
 
  uRefreshMainPanel

---

Code:

---

Public Function uExtractDateTime(ByRef vntValue As Variant, _
                                ByRef strInputFormat As String) As Variant
                               
    ' Verifies that a string expression conforms to the specified
    ' input format and returns a date variable
    ' If the string does not conform to the specified date format,
    ' then the function returns Null
                               
    Dim strTemp As String
    Dim lngHour As Long
    Dim lngMinute As Long
    Dim lngSecond As Long
    Dim strYear As String
    Dim strMonth As String
    Dim strDay As String
   
    If Not uIsSpecified(vntValue) Then
      uExtractDateTime = Null
      Exit Function
    End If
   
    strTemp = Trim(CStr(vntValue))
    strInputFormat = UCase(Trim(strInputFormat))
   
    If Not strInputFormat = "YYYY-MM-DD" And _
          Not strInputFormat = "H:NN:SS" And _
          Not strInputFormat = "H:NN AM/PM" And _
          Not strInputFormat = "YYYY-MM" And _
          Not strInputFormat = "MM-DD-YYYY" Then
      uAppError "modCommon.uExtractDateTime", "Unrecognized date format: " & strInputFormat
    End If
   
    Select Case strInputFormat
     
      Case "YYYY-MM-DD"
          If Len(strTemp) <> 10 And Len(strTemp) <> 8 Then
            uExtractDateTime = Null
            Exit Function
          End If
          If Len(strTemp) = 10 And Mid(strTemp, 5, 1) = "." And Mid(strTemp, 8, 1) = "." Then
            strTemp = Mid(strTemp, 1, 4) & "-" & Mid(strTemp, 6, 2) & "-" & Mid(strTemp, 9, 2)
          End If
          If Len(strTemp) = 10 And Not (strTemp Like "####[-/]##[-/]##") Then
            uExtractDateTime = Null
            Exit Function
          End If
          If Len(strTemp) = 8 Then
            If Not (strTemp Like "########") Then
                uExtractDateTime = Null
                Exit Function
            Else
                strTemp = Mid(strTemp, 1, 4) & "-" & Mid(strTemp, 5, 2) & "-" & Mid(strTemp, 7, 2)
            End If
          End If
          If Not IsDate(strTemp) Then
            uExtractDateTime = Null
          Else
            uExtractDateTime = CDate(strTemp)
          End If
          Exit Function
     
      Case "YYYY-MM"
          If Len(strTemp) <> 7 Then
            uExtractDateTime = Null
            Exit Function
          End If
          If Not ((strTemp Like "####-##") Or _
                  (strTemp Like "####/##")) Then
            uExtractDateTime = Null
            Exit Function
          End If
          If InStr(strTemp, "-") > 0 Then
            strTemp = strTemp & "-01"
          Else
            strTemp = strTemp & "/01"
          End If
          If Not IsDate(strTemp) Then
            uExtractDateTime = Null
          Else
            uExtractDateTime = CDate(strTemp)
          End If
          Exit Function
     
      Case "H:NN:SS"
          If Len(strTemp) = 8 Then
            If Not strTemp Like "##:##:##" Then
                uExtractDateTime = Null
                Exit Function
            End If
            lngHour = CLng(Mid(strTemp, 1, 2))
            lngMinute = CLng(Mid(strTemp, 4, 2))
            lngSecond = CLng(Mid(strTemp, 7, 2))
            If lngHour >= 24 Or lngMinute >= 60 Or lngSecond >= 60 Then
                uExtractDateTime = Null
                Exit Function
            End If
            uExtractDateTime = TimeSerial(lngHour, lngMinute, lngSecond)
          ElseIf Len(strTemp) = 7 Then
            If Not strTemp Like "#:##:##" Then
                uExtractDateTime = Null
                Exit Function
            End If
            lngHour = CLng(Mid(strTemp, 1, 1))
            lngMinute = CLng(Mid(strTemp, 3, 2))
            lngSecond = CLng(Mid(strTemp, 6, 2))
            If lngHour >= 24 Or lngMinute >= 60 Or lngSecond >= 60 Then
                uExtractDateTime = Null
                Exit Function
            End If
            uExtractDateTime = TimeSerial(lngHour, lngMinute, lngSecond)
          Else
            uExtractDateTime = Null
            Exit Function
          End If
         
          Exit Function
     
      Case "H:NN AM/PM"
          If Len(strTemp) = 8 Then
            If Not strTemp Like "##:##???" Then
                uExtractDateTime = Null
                Exit Function
            End If
            If UCase(Mid(strTemp, 7, 2)) <> "AM" And UCase(Mid(strTemp, 7, 2)) <> "PM" Then
                uExtractDateTime = Null
                Exit Function
            End If
            lngHour = CLng(Mid(strTemp, 1, 2))
            lngMinute = CLng(Mid(strTemp, 4, 2))
           
'            If UCase(Mid(strTemp, 7, 2)) = "PM" Then
'                  lngHour = lngHour + 12
'            End If
           
            '* Modified Jun 11, 2011 to correct problems surrounding 12:00 noon
            If UCase(Mid(strTemp, 7, 2)) = "PM" Then
                If lngHour < 12 Then
                  lngHour = lngHour + 12
                End If
            Else
                If lngHour = 12 Then
                  lngHour = 0
                End If
            End If
            If lngHour >= 24 Or lngMinute >= 60 Then
                uExtractDateTime = Null
                Exit Function
            End If
            uExtractDateTime = TimeSerial(lngHour, lngMinute, lngSecond)
          ElseIf Len(strTemp) = 7 Then
            If Not strTemp Like "#:##???" Then
                uExtractDateTime = Null
                Exit Function
            End If
            If UCase(Mid(strTemp, 6, 2)) <> "AM" And UCase(Mid(strTemp, 6, 2)) <> "PM" Then
                uExtractDateTime = Null
                Exit Function
            End If
            lngHour = CLng(Mid(strTemp, 1, 1))
            lngMinute = CLng(Mid(strTemp, 3, 2))
            If UCase(Mid(strTemp, 6, 2)) = "PM" Then
                lngHour = lngHour + 12
            End If
            If lngHour >= 24 Or lngMinute >= 60 Then
                uExtractDateTime = Null
                Exit Function
            End If
            uExtractDateTime = TimeSerial(lngHour, lngMinute, lngSecond)
          Else
            uExtractDateTime = Null
            Exit Function
          End If
         
          Exit Function
     
      Case "MM-DD-YYYY"
          If Len(strTemp) <> 10 And Len(strTemp) <> 8 Then
            uExtractDateTime = Null
            Exit Function
          End If
          If Len(strTemp) = 10 And Mid(strTemp, 3, 1) = "." And Mid(strTemp, 6, 1) = "." Then
                strTemp = Mid(strTemp, 1, 2) & "-" & Mid(strTemp, 4, 2) & "-" & Mid(strTemp, 7, 4)
          End If
          If Len(strTemp) = 10 And Not (strTemp Like "##[-/]##[-/]####") Then
            uExtractDateTime = Null
            Exit Function
          End If
          If Len(strTemp) = 8 Then
            If Not strTemp Like "########" Then
                uExtractDateTime = Null
                Exit Function
            Else
                strTemp = Mid(strTemp, 1, 2) & "-" & Mid(strTemp, 3, 2) & "-" & Mid(strTemp, 5, 4)
            End If
          End If
          uExtractDateTime = Null
          strYear = Mid(strTemp, 7, 4)
          strMonth = Mid(strTemp, 1, 2)
          strDay = Mid(strTemp, 4, 2)
          strTemp = strYear & "-" & strMonth & "-" & strDay
          If Not IsDate(strTemp) Then
            uExtractDateTime = Null
          Else
            uExtractDateTime = CDate(strTemp)
          End If
          Exit Function
     
    End Select
                               
End Function

---

I was not involved in developing this part of the program myself, so I am still trying to figure out how it works with respect to date formatting as well. Let me know if I need to provide anything else.

The vast majority of the Form_Load code is clearly not relevant, these are the only parts we would potentially be interested in (and as such, it would have been better if you had only shown this):

Quote:

---

Originally Posted by gm_lowery

Code:

---

Private Sub Form_Load()

  Dim dteTemp As Date
  Dim i As Long

  m_lngRefreshLevel = 0
  m_blnFormInitialized = False
  ...
 
  ' Initialize reference to UtilDB
  If m_objUtilDB Is Nothing Then
    Set m_objUtilDB = New clsUtilDB
    m_objUtilDB.Init
  End If
 
  m_objUtilDB.IsSeriesMode = True
  ... 

  cboSASRange.Clear
  dteTemp = Int(DateSerial(2010, 1, 3))
  Do While dteTemp < Now() + 720
    cboSASRange.AddItem " week of " & Format(dteTemp, "Mmm DD, YYYY")
    cboSASRange.ItemData(cboSASRange.NewIndex) = Int(dteTemp)
    dteTemp = dteTemp + 7
  Loop
 
  dteTemp = Now()
  For i = 0 To cboSASRange.ListCount - 1
    If cboSASRange.ItemData(i) = Int(uWeekStart(dteTemp)) Then
      cboSASRange.ListIndex = i
      Exit For
    End If
  Next i
 
  m_objUtilDB.ScheduleRequery dteTemp

---

---

Everything there seems fine, but it depends on how the values from cboSASRange are used later, and of course I can't comment on uWeekStart or m_objUtilDB.ScheduleRequery because I can't see the code for them.


As for uExtractDateTime, I don't see how it fits in (as you don't call it from Form_Load), but I can see problems in it. A good example is this:

Code:

---

          strYear = Mid(strTemp, 7, 4)
          strMonth = Mid(strTemp, 1, 2)
          strDay = Mid(strTemp, 4, 2)
          strTemp = strYear & "-" & strMonth & "-" & strDay
          ...
            uExtractDateTime = CDate(strTemp)

---

Unless the string is totally unambiguous (which is not the case here), the values returned by CDate will not be reliable - and will vary based on things outside of your program. There are explanations etc in the article Why are my dates not working properly? from our Classic VB FAQs (in the FAQ forum)

As you should be able to work out based on that article, the safe equivalent is this:

Code:

---

          strYear = Mid(strTemp, 7, 4)
          strMonth = Mid(strTemp, 1, 2)
          strDay = Mid(strTemp, 4, 2)
          ...
            uExtractDateTime = DateSerial(CInt(strYear), CInt(strMonth), CInt(strDay))

---

Thank you! I changed the regional settings as a temporary fix, I will remove CDate from the program and change that aspect around so that it works properly.