Very strange

[Lightlancer]

im my other post i have problems with Runtime access and alot of VBA code,

my database is working correctly in a full version, but not in a runtime version.

after alot of research i found the following:

on the onopen event:

Private Sub Form_Open(Cancel As Integer)
' Niet toegestaan te gebruiken als niet aangemeld
    If IsNothing(glngDezeWerknemerID) Then
        MsgBox "U moet aangemeld zijn om dit schakelbord te kunnen gebruiken.", vbCritical, gstrAppTitel
        Cancel = True
        DoCmd.OpenForm "frmAanmelden", , , , , acDialog
    End If
    
    MsgBox "Welkom " & gstrDezeWerknemer & ", Er zijn op dit moment " & HaalAantalStoringen() & " Openstaande storingen!", vbInformation, "Welkom " & gstrDezeWerknemer & "!"

End Sub

it still give an error message:
"Execution of this application has stopped due to a run-time error."

When reducing it to this: (removing my own code)

Private Sub Form_Open(Cancel As Integer)

End Sub

It still gives the error message, and there is NO code,
but then when i remove this:

Private Sub Form_Open(Cancel As Integer)

End Sub

so there is no VBA code, the error is GONE.....
well can anyone explane to me how this can be?????


The one who has the answer is a Hero!

 

[RuralGuy]

Try doing a a /decompile:

http://www.granite.ab.ca/access/decompile.htm

...then Compact and Repair a couple of times and then recreate the Event code.

RuralGuy (RG for short) aka Allan Bunch MS Access MVP acXP winXP Pro
Please respond to this forum so all may benefit

 

[Lightlancer]

Ok, thanks for the tip,
i tried 5 times, and no luck,
but i now know where i need to look,
its a VBA module called "modHulpprogramma's"

in this module stands the following code:

Option Compare Database   'Gebruik databasevolgorde voor tekenreeksvergelijkingen
Option Explicit           'Afdwingen declaratie alle variabelen

Public Function TelRegels(varTeTesten As Variant) As Integer
'-----------------------------------------------------------
' Invoer : Een tekenreeks
' Uitvoer: Integer met het aantal regeleinden (regels)
'     in de tekenreeks. Nuttig voor bepalen van het aantal
'     regels in een memoveld.
' Gemaakt Door    : JLV 01/31/95
' Laatst Gewijzigd: JLV 01/31/95
'-----------------------------------------------------------
Dim intI As Integer, strWerk As String, intTeller As Integer
    TelRegels = 0
    If VarType(varTeTesten) <> vbString Then Exit Function
    strWerk = varTeTesten
    Do
        intI = InStr(strWerk, Chr$(13))
        If intI = 0 Then Exit Do
        intTeller = intTeller + 1
        strWerk = Mid(strWerk, intI + 1)
    Loop
    TelRegels = intTeller
End Function

Public Function TelWoorden(varTeTesten As Variant) As Integer
'-----------------------------------------------------------
' Invoer : Een tekenreeks
' Uitvoer: Integer met het aantal woorden in de tekenreeks.
' Gemaakt Door    : JLV 01/31/95
' Laatst Gewijzigd: JLV 01/31/95
'-----------------------------------------------------------
Dim intI As Integer, strWerk As String, intTeller As Integer
    TelWoorden = 0
    If VarType(varTeTesten) <> vbString Then Exit Function
    strWerk = Trim(varTeTesten)
    If Len(strWerk) > 0 Then
        ' Begint bij 1 als de tekenreeks niet leeg is
        ' -- past zich aan als geen afsluitende spatie
        intTeller = 1
    Else
        intTeller = 0
    End If
    Do
        ' Zoek de volgende spatie (einde van woord)
        intI = InStr(strWerk, " ")
        If intI = 0 Then Exit Do
        intTeller = intTeller + 1
        ' Verklein de tekenreeks tot de volgende niet-spatie
        strWerk = Trim(Mid(strWerk, intI + 1))
    Loop
    TelWoorden = intTeller
End Function

Public Sub FoutenLogboek(strProc As String, ByVal lngErr As Long, ByVal strFout As String)
'-----------------------------------------------------------
' Invoer : Naam van de procedure die de fout afhandeld
'         Foutwaarde
'         Fouttekst
' Uitvoer: Voegt een rij aan de tabel FoutenLogboek toe
' Gemaakt Door    : JLV 01/31/95
' Laatst Gewijzigd: JLV 01/31/95
'-----------------------------------------------------------
Dim db As Database
Dim rstE As Recordset
Dim strFrmNaam As String
Dim strCtlName As String
Dim lngFoutBewaar As Long
Dim strFoutBewaar As String
  
    On Error Resume Next
    lngFoutBewaar = lngErr
    strFoutBewaar = strFout
    
    Set db = CurrentDb()
    Set rstE = db.OpenRecordset("FoutenLogboek")
    
    rstE.AddNew
    strFrmNaam = Screen.ActiveForm.Name
    rstE!HuidigFormulier = strFrmNaam
    ' Extra contrle om fout door leeg scherm te voorkomen
    If Not IsNothing(strFrmNaam) Then
        strCtlName = Screen.ActiveControl.Name
    End If
    rstE!HuidigBesturingselement = strCtlName
    rstE!ActiefFormulier = Forms.Count
    rstE!GebruikersNaam = CurrentUser
    rstE!Datum = Now
    rstE!AanroependeProcedure = strProc
    rstE!Foutcode = lngFoutBewaar
    rstE!Foutmelding = strFoutBewaar
    rstE.Update
    rstE.Close

End Sub

Public Function ExtractEmail(ByVal strEmail As String) As String
'-----------------------------------------------------------
' Invoer : E-mailhyperlink-tekenreeks
' Uitvoer: Uit tekenreeks gehaalde e-mailadres
'          Levert originele tekenreeks als e-mailadres niet
'          gevonden kan worden
' Gemaakt Door    : JLV 04/13/2003
' Laatst Gewijzigd: JLV 04/13/2003
'-----------------------------------------------------------
Dim intI As Integer, intJ As Integer

    ' Probeer "mailto:" te vinden
    intI = InStr(strEmail, "mailto:")
    ' Als niet gevonden, dan verlaten
    If intI = 0 Then
        ExtractEmail = strEmail
        Exit Function
    End If
    ' Zoek nu naar afsluitende "#"
    intJ = InStr(intI, strEmail, "#")
    ' Als niet gevonden, dan naar einde verwijzen
    If intJ = 0 Then intJ = Len(strEmail) + 1
    ' E-mailadres extraheren en teruggeven
    ExtractEmail = Mid(strEmail, intI + 7, intJ - intI - 7)

End Function

Private Function HaalSoundexCode(strTeken As String) As String
'-----------------------------------------------------------
' Invoer : Een teken
' Uitvoer: U.S. National archive "Soundex"-nummer
'   voor de opgegeven letter
' Gemaakt Door    : JLV 03/01/2003
' Laatst Gewijzigd: JLV 03/01/2003
'-----------------------------------------------------------
    Select Case strTeken
        Case "B", "F", "P", "V"
           HaalSoundexCode = "1"
        Case "C", "G", "J", "K", "Q", "S", "X", "Z"
           HaalSoundexCode = "2"
        Case "D", "T"
            HaalSoundexCode = "3"
        Case "L"
            HaalSoundexCode = "4"
        Case "M", "N"
            HaalSoundexCode = "5"
        Case "R"
            HaalSoundexCode = "6"
    End Select
End Function

Public Function IsFormulierGeladen(ByVal strFormulierNaam As String) As Integer
'-----------------------------------------------------------
' Invoer : Naam van het te testen formulier
' Uitvoer: Waar   = formulier is in Forms-verzameling;
'          Onwaar = niet in Forms-verzameling
' Gemaakt Door    : JLV 01/31/95
' Laatst Gewijzigd: JLV 01/31/95
'-----------------------------------------------------------
    
    On Error GoTo IsFormulierGeladen_Err

    IsFormulierGeladen = (SysCmd(acSysCmdGetObjectState, acForm, strFormulierNaam) <> 0)

IsFormulierGeladen_Exit:
    On Error GoTo 0
    Exit Function

IsFormulierGeladen_Err:
    IsFormulierGeladen = False
    Err.Clear
    Resume IsFormulierGeladen_Exit

End Function

Public Function IsSchrikkeljaar(intJaar As Integer) As Integer
'-----------------------------------------------------------
' Invoer : Een jaar om te testen of het een schrikkeljaar is
' Uitvoer: Waar = Jaar is schrikkeljaar; Onwaar: geen schrikkeljaar
' Gemaakt Door    : JLV 01/08/2002
' Laatst Gewijzigd: JLV 01/08/2002
'-----------------------------------------------------------
    ' Stel foutafhandeling in
    On Error GoTo Bail
    ' Standaardresultaat is Onwaar
    IsSchrikkeljaar = False
    ' Bepaal dag voor datum 29 februari
    ' Is deze dag nog steeds 29, dan is het een schrikkeljaar
    '  (Functie DateSerial geef anders 1 maart als resultaat)
    If 29 = Day(DateSerial(intJaar, 2, 29)) Then
        ' Gevonden, antwoord is Waar
        IsSchrikkeljaar = True
    End If

Klaar:
    Exit Function

Bail:
    ' Eenvoudige code die geen fouten op zou mogen leveren,
    ' maar voor de zekerheid toch netjes verlaten
    Resume Klaar
    
End Function

Public Function IsNothing(ByVal varValueToTest) As Integer
'-----------------------------------------------------------
' Kijkt of variabele gebaseerd op het gegevenstype leeg is
'   Null = leeg
'   Empty = leeg
'   Nummer = 0 is leeg
'   Tekenreeks = "" is leeg
'   Datum/tijd is nooit leeg
' Invoer : Een waarde die op logisch 'leeg' moet worden getest
' Uitvoer: Waar = waarde is logisch 'leeg'; Onwaar: is niet 'leeg'
' Gemaakt Door    : JLV 01/31/95
' Laatst Gewijzigd: JLV 01/31/95
'-----------------------------------------------------------
Dim intSuccess As Integer

    On Error GoTo IsNothing_Err
    IsNothing = True

    Select Case VarType(varValueToTest)
        Case 0      ' Leeg
            GoTo IsNothing_Exit
        Case 1      ' Null
            GoTo IsNothing_Exit
        Case 2, 3, 4, 5, 6  ' Integer, Lang, Enkel, Dubbel, Valuta
            If varValueToTest <> 0 Then IsNothing = False
        Case 7      ' Datum/tijd
            IsNothing = False
        Case 8      ' Tekenreeks
            If (Len(varValueToTest) <> 0 And varValueToTest <> " ") Then IsNothing = False
    End Select


IsNothing_Exit:
    On Error GoTo 0
    Exit Function

IsNothing_Err:
    IsNothing = True
    Resume IsNothing_Exit

End Function

Public Function IsTabel(ByVal strTabelNaam) As Integer
'-----------------------------------------------------------
' Invoer : Naam die gecontroleerd moet worden of het tabel is
' Uitvoer: Waar = naam is een tabelobject; Onwaar = geen tabelobject
' Gemaakt Door    : JLV 01/31/95
' Laatst Gewijzigd: JLV 01/31/95
'-----------------------------------------------------------
Dim intSuccess As Integer
Dim dbCurr As Database, intI As Integer, tdf As TableDef

    On Error GoTo IsTabel_Err
    IsTabel = True

    Set dbCurr = CurrentDb
    Set tdf = dbCurr(strTabelNaam)

IsTabel_Exit:
    On Error GoTo 0
    Exit Function

IsTabel_Err:
    IsTabel = False
    Resume IsTabel_Exit

End Function

Public Function Parse(strIn As String, Optional intPart As Integer, Optional strTeken As String) As String
'-----------------------------------------------------------
' Invoer : Tekenreeks om te verwerken, gewenste deel, scheidingsteken
' Uitvoer: Het 'n-de' deel of 'hap' van de tekenreeks
' Gemaakt Door    : JLV 01/13/2003
' Laatst Gewijzigd: JLV 01/13/2003
'-----------------------------------------------------------
'    strIn    - de te verwerken tekenreeks
'    intPart  - het gezochte deel;  standaardwaarde is 1 als u niets opgeeft
'    strTeken - het scheidingsteken; standaardwaarde is een spatie als u niets opgeeft
Dim strWerk As String, strC As String
Dim intOffset1 As Integer, intOffset2 As Integer
Dim intStart As Integer, intP As Integer, intI As Integer

    ' Standaarddeel is 1
    intP = 1
    ' Controleer of parameter is opgegeven
    If Not IsMissing(intPart) Then
        ' Moet groter zijn dan 0; gebruik anders 1
        If intPart > 0 Then intP = intPart
    End If
    
    ' Standaardscheidingsteken is spatie
    strC = " "
    ' Controleer of parameter is opgegeven
    If Not IsMissing(strTeken) Then
        ' Gebruik eerste teken als meerdere tekens opgegeven
        If Len(strTeken) > 0 Then strC = Left(strTeken, 1)
    End If
    
    ' Elke doorloop zoekt opnieuw naar het teken,
    '  te beginnen bij de laatste positie +1
    For intI = 1 To intP
        intOffset2 = InStr(intOffset1 + 1, strIn, strC)
        If intOffset2 = 0 Then Exit For
        ' Sla de huidige startpositie op
        intStart = intOffset1
        ' Bereken de startpositie voor de volgende zoekronde
        intOffset1 = intOffset2
    Next intI
    
    ' Als startpositie 0 is,
    '  dan bestaat het zoekteken niet of er zijn
    '  geen "intPart" delen
    If intOffset2 = 0 Then Exit Function
    
    ' Lever het antwoord terug
    Parse = Mid(strIn, intStart + 1, intOffset2 - intStart - 1)

End Function

Function ParseDatums(strIn As String, datVan As Date, datTot As Date) As Integer
'-----------------------------------------------------------
' Invoer : Een filtertekenreeks met 'van' en 'tot' datums
' Uitvoer: Tot twee gevonden datums worden in de twee parameters teruggegeven
' Gemaakt Door    : JLV 02/18/02
' Laatst Gewijzigd: JLV 02/18/02
'-----------------------------------------------------------
Dim strWerk As String, intI As Integer, strDatum As String

    strWerk = strIn
    ' Zoek eerste scheidingsteken
    intI = InStr(strWerk, "#")
    ' Niet gevonden - verlaten
    If intI = 0 Then Exit Function
    ' Wis alles tot aan het scheidingsteken
    strWerk = Mid(strWerk, intI + 1)
    ' Zoek het volgende scheidingsteken
    intI = InStr(strWerk, "#")
    ' Niet gevonden - verlaten
    If intI = 0 Then Exit Function
    ' Sla datgene waarvan we denken dat het een datum is,
    ' op in een testvariabele
    strDatum = Left(strWerk, intI - 1)
    ' Controleer of het een datum is
    If Not IsDate(strDatum) Then Exit Function
    ' Datum gevonden - toewijzen
    datVan = DateValue(strDatum)
    ' Haal wat we zojuist hebben gevonden weg
    strWerk = Mid(strWerk, intI + 1)
    ' Zoek het volgende scheidingsteken
    intI = InStr(strWerk, "#")
    ' Niet gevonden - verlaten
    If intI = 0 Then Exit Function
    ' Verwijder tot aan het scheidingsteken
    strWerk = Mid(strWerk, intI + 1)
    ' Zoek het laatste scheidingsteken
    intI = InStr(strWerk, "#")
    ' Niet gevonden - klaar
    If intI = 0 Then Exit Function
    ' Opslaan in testvariabele
    strDatum = Left(strWerk, intI - 1)
    ' Controleer of het een datum is
    If Not IsDate(strDatum) Then Exit Function
    ' Ga naar de tweede!
    datTot = DateValue(strDatum)
    ParseDatums = True
End Function

Function ParseVoornaam(strNaam As String) As Variant
'-----------------------------------------------------------
' Invoer : Een tekenreeks met de naam van een persoon: Achternaam, Voornaam Tussenletters. (Achtervoegsel)
' Uitvoer: De voornaam als tekenreeks
' Comment: Dit is een envelopfunctie voor ParseNaam die vanuit
'   query aangeroepen kan worden om alleen de voornaam te bepalen
' Gemaakt Door    : JLV 12/11/02
' Laatst Gewijzigd: JLV 12/11/02
'-----------------------------------------------------------
Dim strAchternaam As String, varFirst As Variant, varMiddle As Variant, varSuffix As Variant
    
    ' Standaardresultaatwaarde Null
    ParseVoornaam = Null
    ' Aanroepen ParseNaam - is geldig resultaat, dan gezochte deel teruggeven
    If ParseNaam(strNaam, strAchternaam, varFirst, varMiddle, varSuffix) Then
        ParseVoornaam = varFirst
    End If
    
End Function

Function ParseAchternaam(strNaam As String) As String
'-----------------------------------------------------------
' Invoer : Een tekenreeks met de naam van een persoon: Achternaam, Voornaam Tussenletters. (Achtervoegsel)
' Uitvoer: De achternaam als tekenreeks
' Comment: Dit is een envelopfunctie voor ParseNaam die vanuit
'   query aangeroepen kan worden om alleen de achternaam te bepalen
' Gemaakt Door    : JLV 12/11/02
' Laatst Gewijzigd: JLV 12/11/02
'-----------------------------------------------------------
Dim strAchternaam As String, varFirst As Variant, varMiddle As Variant, varSuffix As Variant
    
    ' Aanroepen ParseNaam - is geldig resultaat, dan gezochte deel teruggeven
    If ParseNaam(strNaam, strAchternaam, varFirst, varMiddle, varSuffix) Then
        ParseAchternaam = strAchternaam
    End If

End Function

Function ParseTussenvoegsel(strNaam As String) As Variant
'-----------------------------------------------------------
' Invoer : Een tekenreeks met de naam van een persoon: Achternaam, Voornaam Tussenletters. (Achtervoegsel)
' Uitvoer: De tussenletters als tekenreeks
' Comment: Dit is een envelopfunctie voor ParseNaam die vanuit
'   query aangeroepen kan worden om alleen de tussenletters te bepalen
' Gemaakt Door    : JLV 12/11/02
' Laatst Gewijzigd: JLV 12/11/02
'-----------------------------------------------------------
Dim strAchternaam As String, varFirst As Variant, varMiddle As Variant, varSuffix As Variant
    
    ' Standaardresultaatwaarde Null
    ParseTussenvoegsel = Null
    ' Aanroepen ParseNaam - is geldig resultaat, dan gezochte deel teruggeven
    If ParseNaam(strNaam, strAchternaam, varFirst, varMiddle, varSuffix) Then
        ParseTussenvoegsel = varMiddle
    End If

End Function

Function ParseNaam(strNaam As String, strAchternaam As String, varFirst As Variant, _
    varMiddle As Variant, varSuffix As Variant) As Integer
'-----------------------------------------------------------
' Invoer : Een tekenreeks met de naam van een persoon: Achternaam, Voornaam Tussenletters. (Achtervoegsel)
' Uitvoer: De bouwstenen van de naam als losse tekenreeksen
' Gemaakt Door    : JLV 12/11/02
' Laatst Gewijzigd: JLV 12/11/02
'-----------------------------------------------------------
Dim strWerk As String, intI As Integer

    ' Standaardresultaatwaarde Null (Niet leeg/empty)
    varFirst = Null
    varMiddle = Null
    varSuffix = Null

    ' Verplaats de invoer naar de werktekenreeks
    strWerk = Trim(strNaam)
    ' Zoek eerst het einde van de achternaam
    intI = InStr(strWerk, ",")
    ' Als niet gevonden, lever dan de hele tekenreeks in strAchternaam en verlaten
    If intI = 0 Then
        strAchternaam = strWerk
        ParseNaam = False
        Exit Function
    End If
    ' Wis de achternaam
    strAchternaam = Left(strWerk, intI - 1)
    strWerk = Trim(Mid(strWerk, intI + 1))
    ' Controleer vervolgens of er een achtervoegsel is
    intI = InStr(strWerk, "(")
    If intI <> 0 Then
        ' Achtervoegsel gevonden; opslaan en wissen
        varSuffix = Mid(strWerk, intI + 1, Len(strWerk) - intI - 1)
        strWerk = Trim(Left(strWerk, intI - 1))
    End If
    ' Is het laatste teken nu een punt?
    If Right(strWerk, 1) = "." Then
        ' Ja, aannemen dat het de tussenletters zijn
        varMiddle = Mid(strWerk, Len(strWerk) - 1, 1)
        strWerk = Trim(Left(strWerk, Len(strWerk) - 2))
    End If
    ' Neem aan dat de rest de voornaam is
    If Len(strWerk) > 0 Then varFirst = strWerk
    ParseNaam = True

End Function

Function ParseAchtervoegsel(strNaam As String) As Variant
'-----------------------------------------------------------
' Invoer : Een tekenreeks met de naam van een persoon: Achternaam, Voornaam Tussenletters. (Achtervoegsel)
' Uitvoer: Het achtervoegsel als tekenreeks
' Comment: Dit is een envelopfunctie voor ParseNaam die vanuit
'   query aangeroepen kan worden om alleen het achtervoegsel te bepalen
' Gemaakt Door    : JLV 12/11/02
' Laatst Gewijzigd: JLV 12/11/02
'-----------------------------------------------------------
Dim strAchternaam As String, varFirst As Variant, varMiddle As Variant, varSuffix As Variant
    
    ' Standaardwaarde Null
    ParseAchtervoegsel = Null
    ' Aanroepen ParseNaam - is geldig resultaat, dan gezochte deel teruggeven
    If ParseNaam(strNaam, strAchternaam, varFirst, varMiddle, varSuffix) Then
        ParseAchtervoegsel = varSuffix
    End If

End Function

Function SaveRecord() As Variant
'-----------------------------------------------------------
' Aangeroepen vanuit een eigen menu of werkbalk om het record
' op te slaan. Zoekt de publieke procedure cmdSave_Click in
' het actieve formulier en voert deze uit door deze procdure
' van dit formulier aan te roepen. Is er geen actief formulier
' dan wordt de functie gesloten.
' Gemaakt Door    : JLV 06/09/03
' Laatst Gewijzigd: JLV 06/09/03
'----------------------------------------------------------
' Toevoegen om huidige actieve formulier op te slaan
Dim frm As Form

    ' Sla alle fouten over
    On Error Resume Next
    ' Probeer het active formulier te bepalen
    Set frm = Screen.ActiveForm
    ' Als fout, dan verlaten
    If Err <> 0 Then Exit Function
    ' Probeer nu de procedure voor het opslaan aan te roepen
    frm.cmdSave_Click
    
    ' Klaar
    Err.Clear
    
End Function

Function SetUpper(ByVal strFixCase As Variant) As Variant
'-----------------------------------------------------------
' Invoer : Een tekenreeks met de naam van de persoon
' Uitvoer: Stelt de hoofdletters voor de naam in
' Gemaakt Door    : JLV 07/31/98
' Laatst Gewijzigd: JLV 07/31/98
'-----------------------------------------------------------
    Dim i As Integer
    Dim intSkip As Integer
    Dim intASC As Integer
    Dim strHoofdletter As String
    Dim strLaatste As String

    If VarType(strFixCase) <> 8 Then
        SetUpper = Null
        Exit Function
    End If

    strHoofdletter = strFixCase
    strLaatste = " "    ' Stel het uitgangsteken voor de achternaam in op een spatie

    ' Wijzig allereerst alles in onderkast
    strHoofdletter = LCase$(strHoofdletter)
    
    ' Lus door alle tekens, 1 teken per keer
    For i = 1 To Len(strHoofdletter)
        ' Controleer allereerst of we letters overslaan (speciale gevallen)
        If intSkip > 0 Then
            intSkip = intSkip - 1   ' Ja.  Verlaag teller
            GoTo NextOne            ' en doe volgende teken
            End If
        ' Als 'laaste' teken een spatie of het begin van een tekenreeks was,
        ' controleer dan op de speciale gevallen "O'", "Mc", and "Mac"
        If strLaatste = " " Then
            If Len(strHoofdletter) - i > 2 Then  ' Als ten minste 3 tekens over,
                ' dan als de volgende 2 O' (als in O'Brien) of Mc (als in McDonald) zijn
                If Mid$(strHoofdletter, i, 2) = "o'" Or Mid$(strHoofdletter, i, 2) = "mc" Then
                    ' Maak van de "O" of "M" hoofdletters
                    Mid$(strHoofdletter, i, 1) = UCase$(Mid$(strHoofdletter, i, 1))
                    intSkip = 1     ' en verhoog teller mt 1
                    GoTo NextOne    ' en verwerk volgende teken.
                    End If

                ' Zijn de volgende 3 Mac  (als in MacDougal)
                If Mid$(strHoofdletter, i, 3) = "mac" Then
                    ' maak dan van de "M" een hoofdletter
                    Mid$(strHoofdletter, i, 1) = UCase$(Mid$(strHoofdletter, i, 1))
                    intSkip = 2     ' en verhoog teller met 2
                    GoTo NextOne    ' en verwerk volgende teken.
                    End If
            End If
        End If
        ' Geen speciaal geval, dus controleren of laatste teken een letter of een apostrof is
        intASC = Asc(strLaatste)    ' Gebruik de ASCII-waarde om de controle te vereenvoudigen
        If intASC = 39 Or (intASC >= 97 And intASC <= 122) Or (intASC >= 65 And intASC <= 90) Or (intASC >= 224 And intASC <= 246) Or (intASC >= 248) Then
            ' Was het vorige teken een letter of apostrof, dan dit teken met rust laten
            Else
            ' Was het vorige teken GEEN letter of apostrof, dan er een hoofdletter van maken
            Mid$(strHoofdletter, i, 1) = UCase$(Mid$(strHoofdletter, i, 1))
        End If
        strLaatste = Mid$(strHoofdletter, i, 1)      ' Teken opslaan voor de volgende ronde
NextOne:
        Next i
        SetUpper = strHoofdletter

End Function

Function Soundex(strNaam As String) As String
'-----------------------------------------------------------
' Invoer : Een tekenreeks
' Uitvoer: U.S. National archive "Soundex"-nummer
'   Aan de hand van dit nummer kunnen gelijkklinkende
'   achternamen worden gevonden.
' Gemaakt Door    : JLV 03/01/2003
' Laatst Gewijzigd: JLV 03/01/2003
'-----------------------------------------------------------
' Een soundex-code bestaat uit de eerste letter gevolgd door
' drie cijfers afgeleid uit de evaluatie van de overige letters.
' Klinkers worden genegeerd.  Leveren opeenvolgende letters
' dezelfde numerieke waarde, dan verschijnt deze waarde maar
' één keer. Letters worden als volgt naar nummers vertaald:
'   B, P, F, V = 1
'   C, S, G, J, K, Q, X, Z = 2
'   D, T = 3
'   L = 4
'   M, N = 5
'   R = 6
' Is de uiteindelijke code na evaluatie van alle letters minder
' dan drie tekens lang, dan wordt deze aangevuld met nullen.

' Werkvariabelen
' Tekenreeks om de code op te bouwen en tekenreeks om codenummer te bewaren
Dim strCode As String, strCodeN As String
' Lengte van de originele tekenreeks, laatste geleverde code en lusinteger
Dim intLength As Integer, strLaatsteCode As String, intI As Integer
    
    ' Sla de eerste letter op
    strCode = UCase(Left(strNaam, 1))
    ' Sla zijn codenummer op om op duplicaten te controleren
    strLaatsteCode = HaalSoundexCode(strCode)
    ' Bereken de lengte voor de evaluatie
    intLength = Len(strNaam)
        
    ' Creëer de code te beginnen met de tweede letter
    For intI = 2 To intLength
        strCodeN = HaalSoundexCode(Mid(strNaam, intI, 1))
        ' Als twee gelijke letters naast elkaar staan,
        ' dan wordt er maar één geteld
        If Len(strCodeN) > 0 And strLaatsteCode <> strCodeN Then
            ' Ander codenummer, toevoegen aan resultaat
            strCode = strCode & strCodeN
        End If
        ' Sla het laatste codenummer op
        strLaatsteCode = strCodeN
    ' Lus
    Next intI
    
    ' Controleer de lengte
    If Len(strCode) < 4 Then
        ' Opvullen met nullen
        strCode = strCode & String(4 - Len(strCode), "0")
    Else
        ' Zorg dat het totaal niet meer dan vier tekens lang is
        strCode = Left(strCode, 4)
    End If
    
    ' Lever het resultaat terug
    Soundex = strCode
End Function

The function in my Home screen is the IsNothing function, it doesnt seem to work in the Runtime Access version.
Maybe a error in the code???

Greetz

 

[Lightlancer]

I think access tries to tell me that the module doesnt exist, i had this problem long time before....... dont know how i solved that, because when i remove in all forms all code that has to do with this module, the DB work perfectly again......

 

[JBinQLD]

At fear of sounding negative, you really need to streamline your posts a llttle?

I look at what you've posted and have no inclination to assist because doing so would possibly take longer than waiting for my wife to admit she can't drive.

Ie. We could all be here not only while our hair turns grey but potentially when it falls out too.


JB

 

[MajP]

You did a complete decompile 5 times? It is pretty clear from what you said that you have to do a full decompile, not just a compact and repair. If you have not done a full decompile look at RuralGuys post he hit it on the head.

After that you need to put error checking in all of your sub routines. I would have been embarrassed to have posted that complex of code without error checking, and then ask for help. Like JB said, we like to help, but no one is going to help without a little effort on your part.

 

[boblarson]

If your module is truly named:

modHulpprogramma's

get rid of the quote and rename it:

modHulpprogrammas

Bob Larson
Access MVP
Free Access Tutorials and Samples:

http://www.btabdevelopment.com

 

[Lightlancer]

Well i got it fixed for now, i created an accde instead of accdb, and now all errors are gone......