Kan kun skrive ændring i database 1 gang.
Hej med jer experter :-)Kan nogen sige mig hvad der går galt i denne subroutine?
Den virker perfekt men kun 1 gang, når brugeren vælger et nyt fakturanummer, er databasen skrivebeskyttet. Jeg er tabt på denne, og en anden bruger har foreslået noget med "begintrans" og "committrans" har googlet det, og kan ikke få puslespillet til at gå op. Nogen med lysten til at kigge på det ?
Meget gerne med forslag til ny programkode.
Her er min kode:
Public Sub Hent_Fakturanum_Valg()
' Deklarerer variabler
Dim Sheetname As String
Dim Conn As ADODB.Connection
Dim Rst As ADODB.Recordset
On Error GoTo Errorhandler
' Bruger det aktuelle Ark til dataene
Sheetname = ActiveSheet.Name
If Fakturanummer = 0 Then Exit Sub
' Fakturanummer kommer fra Formularen "FakturaBetalinger"
' Spørger brugeren om han er sikker på sit valg.
Answer = MsgBox("Er du sikker på, at du vil sætte fakturanummer " & Fakturanummer & " som ""Betalt""?", vbOKCancel)
If Answer = vbCancel Then Exit Sub
' Åbner database
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\faktura_Salg\fakturaer.mdb;"
Set Rst = CreateObject("ADODB.Recordset")
' Søger i database, efter det valgte fakturanummer fra formularen
strsql = "SELECT * From Betaling WHERE ((Betaling.FakturaNr) like '" & Fakturanummer & "');"
Rst.Open strsql, Conn, adOpenKeyset, adLockOptimistic, adCmdText
' Finder første macth.
Rst.MoveFirst
' Sætter match som værende betalt
With Rst
.Fields("Betalt") = -1
.Update
End With
' Afslutter og lukker database og recordset
Rst.Close
Set Rst = Nothing
Conn.Close
Set Conn = Nothing
Set CurrentChart = Sheets(Sheetname)
Sheets(Sheetname).Select
ExitHere:
Set Conn = Nothing
Exit Sub
Errorhandler:
MsgBox Err.Description
Resume ExitHere
End Sub
Mange hilsener
Voyager
