Running Form_open twice

[irenicus]

Hi all,

I Got a form with a form_open event. Problem that i have is that this event is ALWAYS run twice instead of the wanted 1 time. This also happens when using the form_load and form_activate events.

Does anybody have any idea what can be done about it? I am using Acces 2000 with VBA 6.0

Thanks a lot

[edit] tested some more, this event is ONLY run twice when i use the docmd.openform procedure t open the form, not when openening it manually. Is thewre any other way to open a form in a way that this doesent cause the form_open procedure to be executed twice? [/edit]

[irenicus]

Created a workaround it but i still want to know why open form is executed twice when using docmd.openform in VBA, so anyone?

[alex_read]

where's your procedure code which you open this with? - docmd on it's own just opens the form once...

[irenicus]

ill post it tomorrow dont have the code here, but dont expect something strange, i just use docmd.openform

[alex_read]

If you can post the bit calling this form to open, as well as any procedures of the form which are run when it first starts up, I'll take a look

[irenicus]

Originally posted by alex_read
If you can post the bit calling this form to open, as well as any procedures of the form which are run when it first starts up, I'll take a look

Ok here it is:

procedure opening form

Private Sub UpdateData_Click()
  
  Dim rs As DAO.Recordset
  Dim sSQL As String
  Dim bAutoUpdate As Boolean
  Dim bEnkelUpdates As Boolean
  
  ......
  
  If bAutoUpdate Then
    [Form_Update Peak information].GetUpdateInformation
  Else
    DoCmd.OpenForm [Form_Update Peak information].name
  End If
  
  .......
  
End Sub

Procedure on form (on open)

Private Sub Form_Open(Cancel As Integer)

  Dim rs As DAO.Recordset
  Dim sSQL As String
  
  'Opvragen update checkbox status
  sSQL = "Select waarde from opties where ucase(parameter) = ""PEAK_ENKELUPDATES"""
  Set rs = CurrentDb.OpenRecordset(sSQL)
  rs.MoveFirst
  CheckEnkelUpdates = rs.Fields("waarde").Value 'toevoeging
  rs.Close
  
  'THE WORKAROUND SO IT IS ONLY RUN ONCE:

  If [Form_main menu].LStatus.Caption = "Controleren op updates voltooid" Then
    GetUpdateInformation CheckEnkelUpdates, False
  End If
  [Form_main menu].LStatus.Caption = "Controleren op updates voltooid"

End sub

GetUpdateInformation:

Sub GetUpdateInformation(Optional bEnkelUpdates As Boolean = False, _
                         Optional bAutoUpdate As Boolean = True, _
                         Optional bUpdateFromForm As Boolean = False)

  'Zoekt naar bestanden en roept de procedure aan waar wordt gecontroleerd op updates
  '(ControlerenCSV)
  Dim rs As DAO.Recordset
  Dim sSQL As String
  Dim sDirectory As String
  Dim sDataDirSearch As String
  Dim sDirNaam As String
  Dim bStandardUpdate As Boolean
  Dim bSampleUpdate As Boolean
 
  DoCmd.SetWarnings False
  bStandardUpdate = False
  bSampleUpdate = False
  lbSelectedFiles.RowSource = ""
  LbFiles.RowSource = ""
  
  If (bAutoUpdate Or Not bUpdateFromForm) Then 'autoupdate of listboxen vullen
    'Auto opvragen dir
    sSQL = "Select waarde from metadata where ucase(parameter) = ""PROJECTDIRECTORY"""
    Set rs = CurrentDb.OpenRecordset(sSQL)
    rs.MoveFirst
    sDirectory = rs.Fields("waarde").Value
    rs.Close
    'Keuze directory....
    'Nog weer toevoegen met als default dir de metadir directory
  
    'Zoeken databestanden uit directory
    sDataDirSearch = sDirectory & "*.d"
    sDirNaam = Dir(sDataDirSearch, vbDirectory)
    Do While Len(sDirNaam) > 0
      If FileDateTime(sDirectory & sDirNaam & "\CSV Results.CSV") <> "" Then
        'Bepalen of er updates zijn
        ControlerenCSV sDirectory & sDirNaam & "\CSV Results.CSV", 50, bEnkelUpdates, bAutoUpdate, bStandardUpdate, bSampleUpdate
      End If
      sDirNaam = Dir()
    Loop
  End If
  If (Not bAutoUpdate And Not bUpdateFromForm) Then 'Geen autoupdate listboxen gevuld
  'Kijken of listbox gewijzigde data leeg is
    If LbFiles.ListCount = 0 Then
      MsgBox "Er zijn geen gewijzigde bestanden gevonden"
    End If
    [Form_main menu].LStatus.Caption = "Controleren op updates voltooid."
  End If
  
  If (bAutoUpdate Or bUpdateFromForm) Then 'is er geüpdate of enkel data opgevraagd dan:
    'Wanneer updates dan meldingen naar gebruiker.
    If bStandardUpdate Then
      MsgBox "Er zijn wijzigingen in standaarden. U zult eerst de betreffende standaarden opnieuw moeten " & vbCrLf & _
             "controleren en vervolgens alle monsters opnieuw.", vbInformation
      'Updaten tabel samples, alle monsters als updated markeren.
      'DoCmd.RunSQL ("update samples set upd = true")
    ElseIf bSampleUpdate Then
      MsgBox "Er zijn wijzigingen in monsters. U zult betreffende monsters opnieuw moeten bekijken op afwijkingen.", vbInformation
    End If
    [Form_main menu].LStatus.Caption = "Updaten data voltooid."
  End If

End Sub

Procedure ControlerenCSV

Sub ControlerenCSV(sFile As String, iFileNr As Integer, _
                   bEnkelUpdates As Boolean, _
                   Optional bUpdate As Boolean = False, _
                   Optional bStandardUpdate As Boolean = False, _
                   Optional bSampleUpdate As Boolean = False)

    
  Dim sData As String
  Dim sFileName As String
  Dim sSample As String
  Dim sVial As String
  Dim sSQL As String
  Dim sMonsterType As String
  Dim rsResult As ResultInformation
  Dim i As Integer
  Dim fr1 As Single
  Dim fr2 As Single
  Dim rs As DAO.Recordset
  Dim slistSeperator As String

  'On Error GoTo foutafhandeling

  [Form_main menu].LStatus.Caption = "Bezig zoeken naar updates in bestand " & sFile & "..."
  [Form_main menu].Repaint
  
  slistSeperator = GetInternationalSetting(0, LOCALE_SLIST)

  Open sFile For Input As #iFileNr
  Input #iFileNr, sData
  If Left(sData, 7) = "[Header" Then
    
    'Sequence data (Filename)
    
    For i = 1 To 4
      Input #iFileNr, sData
    Next i
    sFileName = sData
    Input #iFileNr, sData
    Input #iFileNr, sData
    sSample = sData
    Input #iFileNr, sData
    Input #iFileNr, sData
    sVial = sData
    For i = 1 To 14
      Input #iFileNr, sData
    Next i
    
    'opvragen monstersoort uit db
    
    sSQL = "select Monstertype from sequence where filename = """ & sFileName & """"
    Set rs = CurrentDb.OpenRecordset(sSQL)
    rs.MoveFirst
    sMonsterType = rs.Fields("monstertype").Value
    rs.Close
    
    'Result data
  
    While sData <> "[EOF]"
      rsResult.sComponent = sData
      Input #iFileNr, sData
      rsResult.sAmount = sData
      Input #iFileNr, sData
      rsResult.sunit = sData
      Input #iFileNr, sData
      rsResult.sTargetRetentionTime = sData
      Input #iFileNr, sData
      rsResult.sTargetRespons = sData
      Input #iFileNr, sData
      rsResult.sQValue = sData
      Input #iFileNr, sData
      rsResult.sQ1RetentionTime = sData
      Input #iFileNr, sData
      rsResult.sQ1Respons = sData
      Input #iFileNr, sData
      rsResult.sQ2RetentionTime = sData
      Input #iFileNr, sData
      rsResult.sQ2Respons = sData
      If rsResult.sTargetRespons = 0 Or _
         rsResult.sQ1Respons = 0 Then
        fr1 = 0
      Else
        fr1 = rsResult.sTargetRespons / rsResult.sQ1Respons
      End If
      If rsResult.sTargetRespons = 0 Or _
         rsResult.sQ2Respons = 0 Then
        fr2 = 0
      Else
        fr2 = rsResult.sTargetRespons / rsResult.sQ2Respons
      End If
      'Vergelijk data
        
      sSQL = ("select * from peaks" & _
              " Where file = """ & sFileName & _
              """ and sample = """ & sSample & _
              """ and component = """ & rsResult.sComponent & _
              """ and amount = " & rsResult.sAmount & _
                " and units = """ & rsResult.sunit & _
              """ and [ts retention time] = " & rsResult.sTargetRetentionTime & _
                " and [q1 retention time] = " & rsResult.sQ1RetentionTime & _
                " and [q2 retention time] = " & rsResult.sQ2RetentionTime & _
                " and [q value] = " & rsResult.sQValue & _
                " and [target response] = " & rsResult.sTargetRespons & _
                " and [q1 response] = " & rsResult.sQ1Respons & _
                " and [q2 response] = " & rsResult.sQ2Respons)
      Set rs = CurrentDb.OpenRecordset(sSQL)
      If rs.RecordCount = 0 Then
        'Monster is veranderd!
        If Not bUpdate Then
          LbFiles.RowSource = LbFiles.RowSource & sFileName & slistSeperator & sSample & slistSeperator & "JA" & slistSeperator
          Close #iFileNr
          Exit Sub
        Else
          'Eventueel in de toekomst, controleren of file überhaupt wel bestaat en
          'of er dus een update nodig is of een toevoeging. -> importerenCSV sFile, 50
          
          'UPDATE RECORD. Wordt van het volgende uitgegaan:
          '- Zijn GEEN complete monsters verwijderd.
          '- Zijn GEEN monsters omgewissld
          '- Zijn GEEN nieuwe monsters. Wanneer dit is gewenst is dit eenvoudig toe
          '  te voegen onder ControlerenCSV
          'Werkwijze:
          '- Sequence info ongewijzigd
          '- Updaten peak informatie
          UpdatePeakInformation sFileName, sSample, sVial, rsResult, fr1, fr2
          '- Bepalen of het een standaard, blanco of monster is. afhankelijk daarvan
          '  calibratiestap en of monsterstap moet opnieuw gedaan worden.
          'Booleans activeren voor waarschuwingen
          If UCase(sMonsterType) = "STD" Then bStandardUpdate = True
          If UCase(sMonsterType) = "SMPL" Then bSampleUpdate = True
        End If
      End If
      Input #iFileNr, sData
    Wend
  End If
  Close #iFileNr
  
  'Monster is onveranderd
  If Not bEnkelUpdates And _
     Not bUpdate Then
    LbFiles.RowSource = LbFiles.RowSource & sFileName & slistSeperator & sSample & slistSeperator & "NEE" & slistSeperator
  End If
  
foutafhandeling:

  If Err.Number <> 0 Then
    MsgBox "Fout:" & Err.description, vbExclamation
    Close iFileNr
    [Form_main menu].LStatus.Caption = "Fout opgetreden tijdens updaten monsterinformatie. Foutcode: " & Err.Number
    Err.Number = 0
    Exit Sub
  End If
  
End Sub

[irenicus]

procedure UpdatePeakInformation

Sub UpdatePeakInformation(sFileName As String, sSample As String, sVial As String, _
                          rsResult As ResultInformation, fr1 As Single, fr2 As Single)
      
DoCmd.RunSQL ("update peaks set " & _
              "file = """ & sFileName & """, " & _
              "sample = """ & sSample & """, " & _
              "vial = """ & sVial & """, " & _
              "component = """ & rsResult.sComponent & """, " & _
              "Amount = """ & rsResult.sAmount & """, " & _
              "Units = """ & rsResult.sunit & """, " & _
              "[ts retention time] = """ & rsResult.sTargetRetentionTime & """, " & _
              "[q1 retention time] = """ & rsResult.sQ1RetentionTime & """, " & _
              "[q2 retention time] = """ & rsResult.sQ2RetentionTime & """, " & _
              "[q value] = """ & rsResult.sQValue & """, " & _
              "[Target Response] = """ & rsResult.sTargetRespons & """, " & _
              "[Q1 Response] = """ & rsResult.sQ1Respons & """, " & _
              "[Q2 Response] = """ & rsResult.sQ2Respons & """, " & _
              "[r1] = """ & fr1 & """, " & _
              "[r2] = """ & fr2 & """, " & _
              "Upd = true " & _
              "where File = """ & sFileName & """ and component = """ & rsResult.sComponent & """")

End Sub

Thanks for the help

[alex_read]

no idea from looking through that one - this seems fine to me. Can you try stepping through the code & seeing which lines it's called on ?

[irenicus]

When i mark the line where the form is opened and the first line in the procedure "Form_open" and i run it the line where the form is opened is passed 1 time, the first line in the procedure "For_open" twice

[irenicus]

I will try step through the whole procedures and find out where the "form open" procedure is executed again...

[irenicus]

Doesent seem to execute "open_form" again from within any of the other procedures. Open_form is completely executed and afterwards executed one more time.

So u also have no idea what can cause this?