VB6 foutcode 3021

Status
Niet open voor verdere reacties.

mnemonic

Gebruiker
Lid geworden
25 mrt 2016
Berichten
114
Ik heb een factureringsprogramma die op een nieuwe pc is geïnstalleerd (W10).
Ben zelf al een aantal foutmeldingen tegen gekomen maar deze ?
Als ik een factuur maak en er daarna nog één wil maken krijg ik deze fout.
Schakel ik de pc uit en weer aan kan ik weer 1 factuur maken voor ik de fout weer krijg.
Zelf begin ik net met VBA te stoeien en heb weinig tot geen kennis.
Wie o wie kan en wil mij hier mee helpen.
Hij geeft bij de fout bij de volgende tekst

'naam patient
tekst = rs!nm_patient




HTML:
Public Sub vullen()
Dim db As Database
Dim nr

    ActiveWindow.WindowState = wdWindowStateMinimize
    
    Set db = OpenDatabase("c:\ttl account\ttlaccount.mdb")
    naam = ActiveDocument.Name
    tel = Len(naam)
    aant = tel - 4
    nr = Left$(naam, aant)
    
'UIT FAKTUUR
    sql = "select * from faktuur where notanum = " & nr & ""
    Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
'naam patient
     tekst = rs!nm_patient
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<patient>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.TypeText tekst
'notanummer
    notanr = rs!notanum
    tekst = rs!notanum
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<notanummer>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.TypeText tekst
'nummer bon
    tekst = rs!num_bon
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<nummer bon>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.TypeText tekst
'totaal
    teksttotaal = rs!bedrag
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<totaal>"
        .Forward = True
    End With
    Selection.Find.Execute
    tel = Len(teksttotaal)
    Selection.TypeText teksttotaal
    'evt plaatsen nul(len)
    DoEvents
    komma

'GEGEVENS TANDARTS
    nrt = rs!num_tandarts
    sql = "select * from gegevens where nummer = " & nrt & ""
    Set rs2 = db.OpenRecordset(sql, dbOpenSnapshot)
'naam tandarts
    tekst = rs2!naam
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<naam>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.TypeText tekst
'adres tandarts
    tekst = rs2!adres
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<adres>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.TypeText tekst
'postcode tandarts
    tekst = rs2!postcode
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<postcode>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.TypeText tekst
'plaats tandarts
    tekst = rs2!plaats
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<plaats>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.TypeText tekst
    
'UIT NOTAS
    sql = "select * from notas where notanr = " & notanr & ""
    Set rs3 = db.OpenRecordset(sql, dbOpenSnapshot)
    Do While Not rs3.BOF And Not rs3.EOF
    DoEvents
'omschrijving
    o = rs3!artikel
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<<1>>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.TypeText o
'aantal
    aant = rs3!Aantal
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<<2>>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.TypeText aant
'prijs per stuk (halen uit artikel)
    omschr = rs3!artikel
    DoEvents
    sql = "select * from artikel where omschrijving = '" & omschr & "' "
    Set rs4 = db.OpenRecordset(sql, dbOpenSnapshot)
    tekstp = rs4!prijs
'korting?
    nrt2 = "t" & nrt
    DoEvents
    sql = "select * from artikel where omschrijving = '" & omschr & "' "
    Set rs5 = db.OpenRecordset(sql, dbOpenSnapshot)
    DoEvents
    k = rs5.Fields(nrt2).Value
    If k = 0 Then
        pp = tekstp
    Else
        pp = tekstp / 100 * (100 - k)
    End If
    p = Int(pp * 100) / 100
'plaatsen prijs per stuk
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<<3>>"
        .Forward = True
    End With
    Selection.Find.Execute
    tel = Len(p)
    Selection.TypeText p
    'evt plaatsen nul(len)
    DoEvents
    komma

'berekenen en plaatsen bedrag
    oudbedr = p * aant
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<<4>>"
        .Forward = True
    End With
    Selection.Find.Execute
    bedr = Int(oudbedr * 100) / 100
    tel = Len(bedr)
    Selection.TypeText bedr
    'evt plaatsen nul(len)
    DoEvents
    komma
    
'materiaalspecificatie?
    mat = rs4!materiaalspecificatie
    If mat <> "" Then
        Selection.HomeKey Unit:=wdStory
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "<matspec>"
            .Forward = True
        End With
        Selection.Find.Execute
        Selection.TypeText mat
        Selection.TypeParagraph
        Selection.TypeText "<matspec>"
    End If
    
    DoEvents
    rs3.MoveNext
    Loop

'verwijderen "lege" velden
    With Selection.Find
        Do While .Execute(FindText:="<<1>>", Forward:=False, Format:=False, Wrap:=wdFindContinue) = True
            Selection.Find.ClearFormatting
            Selection.Find.Replacement.ClearFormatting
        DoEvents
        Selection.MoveLeft Unit:=wdWord, Count:=1
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        Selection.Delete Unit:=wdCharacter, Count:=1
        Loop
    End With
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<matspec>"
        .Forward = True
    End With
    Selection.Find.Execute
    Selection.Delete Unit:=wdCharacter, Count:=1

    printen.Show
    
End Sub

alvast bedankt
Jan
 
Die gele tekst is niet te lezen.
Heb je al met Google gezocht op vb6 error 3021?
Daar krijg je genoeg op terug.
 
Hoi Edmoor,
Ja ik had al op internet gekeken maar dat gaat mij allemaal net iets verder dan ik ben.
Waarom de helft van de code geel is geen idee maar hieronder is hij in het zwart.







Public Sub vullen()
Dim db As Database
Dim nr

ActiveWindow.WindowState = wdWindowStateMinimize

Set db = OpenDatabase("c:\ttl account\ttlaccount.mdb")
naam = ActiveDocument.Name
tel = Len(naam)
aant = tel - 4
nr = Left$(naam, aant)

'UIT FAKTUUR
sql = "select * from faktuur where notanum = " & nr & ""
Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
'naam patient
tekst = rs!nm_patient
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<patient>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst
'notanummer
notanr = rs!notanum
tekst = rs!notanum
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<notanummer>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst
'nummer bon
tekst = rs!num_bon
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<nummer bon>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst
'totaal
teksttotaal = rs!bedrag
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<totaal>"
.Forward = True
End With
Selection.Find.Execute
tel = Len(teksttotaal)
Selection.TypeText teksttotaal
'evt plaatsen nul(len)
DoEvents
komma

'GEGEVENS TANDARTS
nrt = rs!num_tandarts
sql = "select * from gegevens where nummer = " & nrt & ""
Set rs2 = db.OpenRecordset(sql, dbOpenSnapshot)
'naam tandarts
tekst = rs2!naam
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<naam>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst
'adres tandarts
tekst = rs2!adres
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<adres>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst
'postcode tandarts
tekst = rs2!postcode
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<postcode>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst
'plaats tandarts
tekst = rs2!plaats
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<plaats>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst

'UIT NOTAS
sql = "select * from notas where notanr = " & notanr & ""
Set rs3 = db.OpenRecordset(sql, dbOpenSnapshot)
Do While Not rs3.BOF And Not rs3.EOF
DoEvents
'omschrijving
o = rs3!artikel
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<<1>>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText o
'aantal
aant = rs3!Aantal
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<<2>>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText aant
'prijs per stuk (halen uit artikel)
omschr = rs3!artikel
DoEvents
sql = "select * from artikel where omschrijving = '" & omschr & "' "
Set rs4 = db.OpenRecordset(sql, dbOpenSnapshot)
tekstp = rs4!prijs
'korting?
nrt2 = "t" & nrt
DoEvents
sql = "select * from artikel where omschrijving = '" & omschr & "' "
Set rs5 = db.OpenRecordset(sql, dbOpenSnapshot)
DoEvents
k = rs5.Fields(nrt2).Value
If k = 0 Then
pp = tekstp
Else
pp = tekstp / 100 * (100 - k)
End If
p = Int(pp * 100) / 100
'plaatsen prijs per stuk
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<<3>>"
.Forward = True
End With
Selection.Find.Execute
tel = Len(p)
Selection.TypeText p
'evt plaatsen nul(len)
DoEvents
komma

'berekenen en plaatsen bedrag
oudbedr = p * aant
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<<4>>"
.Forward = True
End With
Selection.Find.Execute
bedr = Int(oudbedr * 100) / 100
tel = Len(bedr)
Selection.TypeText bedr
'evt plaatsen nul(len)
DoEvents
komma

'materiaalspecificatie?
mat = rs4!materiaalspecificatie
If mat <> "" Then
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<matspec>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText mat
Selection.TypeParagraph
Selection.TypeText "<matspec>"
End If

DoEvents
rs3.MoveNext
Loop

'verwijderen "lege" velden
With Selection.Find
Do While .Execute(FindText:="<<1>>", Forward:=False, Format:=False, Wrap:=wdFindContinue) = True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
DoEvents
Selection.MoveLeft Unit:=wdWord, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Loop
End With
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<matspec>"
.Forward = True
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1

printen.Show

End Sub
 
Plaats je code in codetags, zo is het nog niet te volgen.
Het lijkt me dat je aan het einde van de rit de database moet sluiten omdat je met een BOF of EOF fout zit.
 
Hoi Edmoor,
" Het lijkt me dat je aan het einde van de rit de database moet sluiten omdat je met een BOF of EOF fout zit."
Dit wordt ook vaak op internet vermeld alleen niet hoe het verder moet.



Code:
Public Sub vullen()
Dim db As Database
Dim nr

ActiveWindow.WindowState = wdWindowStateMinimize

Set db = OpenDatabase("c:\ttl account\ttlaccount.mdb")
naam = ActiveDocument.Name
tel = Len(naam)
aant = tel - 4
nr = Left$(naam, aant)

'UIT FAKTUUR
sql = "select * from faktuur where notanum = " & nr & ""
Set rs = db.OpenRecordset(sql, dbOpenSnapshot)


'naam patient
tekst = rs!nm_patient
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<patient>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst


'notanummer
notanr = rs!notanum
tekst = rs!notanum
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<notanummer>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst


'nummer bon
tekst = rs!num_bon
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<nummer bon>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst


'totaal
teksttotaal = rs!bedrag
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<totaal>"
.Forward = True
End With
Selection.Find.Execute
tel = Len(teksttotaal)
Selection.TypeText teksttotaal
'evt plaatsen nul(len)
DoEvents
komma


'GEGEVENS TANDARTS
nrt = rs!num_tandarts
sql = "select * from gegevens where nummer = " & nrt & ""
Set rs2 = db.OpenRecordset(sql, dbOpenSnapshot)
'naam tandarts
tekst = rs2!naam
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<naam>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst


'adres tandarts
tekst = rs2!adres
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<adres>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst


'postcode tandarts
tekst = rs2!postcode
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<postcode>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst


'plaats tandarts
tekst = rs2!plaats
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<plaats>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText tekst


'UIT NOTAS
sql = "select * from notas where notanr = " & notanr & ""
Set rs3 = db.OpenRecordset(sql, dbOpenSnapshot)
Do While Not rs3.BOF And Not rs3.EOF
DoEvents
'omschrijving
o = rs3!artikel
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<<1>>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText o


'aantal
aant = rs3!Aantal
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<<2>>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText aant


'prijs per stuk (halen uit artikel)
omschr = rs3!artikel
DoEvents
sql = "select * from artikel where omschrijving = '" & omschr & "' "
Set rs4 = db.OpenRecordset(sql, dbOpenSnapshot)
tekstp = rs4!prijs


'korting?
nrt2 = "t" & nrt
DoEvents
sql = "select * from artikel where omschrijving = '" & omschr & "' "
Set rs5 = db.OpenRecordset(sql, dbOpenSnapshot)
DoEvents
k = rs5.Fields(nrt2).Value
If k = 0 Then
pp = tekstp
Else
pp = tekstp / 100 * (100 - k)
End If
p = Int(pp * 100) / 100


'plaatsen prijs per stuk
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<<3>>"
.Forward = True
End With
Selection.Find.Execute
tel = Len(p)
Selection.TypeText p
'evt plaatsen nul(len)
DoEvents
komma


'berekenen en plaatsen bedrag
oudbedr = p * aant
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<<4>>"
.Forward = True
End With
Selection.Find.Execute
bedr = Int(oudbedr * 100) / 100
tel = Len(bedr)
Selection.TypeText bedr
'evt plaatsen nul(len)
DoEvents
komma


'materiaalspecificatie?
mat = rs4!materiaalspecificatie
If mat <> "" Then
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<matspec>"
.Forward = True
End With
Selection.Find.Execute
Selection.TypeText mat
Selection.TypeParagraph
Selection.TypeText "<matspec>"
End If


DoEvents
rs3.MoveNext
Loop


'verwijderen "lege" velden
With Selection.Find
Do While .Execute(FindText:="<<1>>", Forward:=False, Format:=False, Wrap:=wdFindContinue) = True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
DoEvents
Selection.MoveLeft Unit:=wdWord, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Loop
End With
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<matspec>"
.Forward = True
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1

printen.Show

End Sub
 
Probeer het eens met:
Set db = Nothing
Set rs = Nothing
 
Edmoor het is gelukt.
Geen melding meer gekregen.
Dank je voor het meedenken. Super :thumb:
 
Ok dan :)
Ik denk overigens dat het sluiten van de RecordSet voldoende is.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan