D
Dirk Batenburg
I have a procedure to update my Access records from Excel via an ADO
connection. The Excel file has 3315 records. The procedure works fine till
record 2184 and then the procedure stops without debugging information. Is
there a limit of records transfert?
Please help,
Regards,
Dirk Batenburg
The code:
Private Sub cmd_WerkBy_Click()
Dim sZoek As String
Dim tZoek As String
Dim teller As Integer
Dim MaxRegel As Integer
'Database openen
sDBLocation = App.Path & "\BemiddelingsBureau.mdb"
Set dbBloemen = OpenDatabase(sDBLocation)
Set rsBloemen = dbBloemen.OpenRecordset("Bloemen", dbOpenTable)
'Tabel in Access
rsBloemen.Index = "Regelnr"
'On Error Resume Next
Set objExcel = New excel.Application
Set objExlWork = objExcel.Workbooks.Open("D:\Mijn
documenten\Bloemen\Flobase.xls")
'Afsluiten als bestand niet bestaat
If objExlWork Is Nothing Then GoTo ErrorHandler
'Werkblad instellen
Set objSheet = objExlWork.Sheets("Inkoop")
objSheet.Activate
'objExcel.Visible = True 'Excel zichtbaar maken
'Eerste cel activeren
objSheet.Range("A2").Activate
objSheet.Cells.End(xlDown).Activate
MaxRegel = ActiveCell.Row - 1
MsgBox MaxRegel
HuidReg = 2
VorigReg = 2
'r = ActiveCell.Row
bar_Voortgang.Visible = True
bar_Voortgang.Min = 1
bar_Voortgang.Max = MaxRegel
teller = 0
rsBloemen.MoveFirst
While HuidReg < MaxRegel
rsBloemen.Index = "Regelnr"
r = HuidReg
teller = teller + 1
bar_Voortgang.Value = teller
lbl_RegelNr.Caption = teller
lbl_RegelNr.Refresh
sZoek = FormatNr(readExcel(r, 2))
If Len(Trim(sZoek)) = 0 Then GoTo GeenArtKode
tZoek = readExcel(r, 1)
rsBloemen.Seek "=", sZoek, tZoek
If rsBloemen.NoMatch Then '1.
rsBloemen.Index = "Artnummer"
sZoek = FormatNr(readExcel(r, 2))
rsBloemen.Seek "=", sZoek
If rsBloemen.NoMatch Then '2.
'Nieuw record aanmaken
rsBloemen.AddNew
rsBloemen!regel = readExcel(r, 1)
rsBloemen!Artikelnr = readExcel(r, 2)
rsBloemen!Aantal = readExcel(r, 3)
rsBloemen!OMSCHRIJVING = readExcel(r, 4) + " " + readExcel(r, 5)
rsBloemen!Knoppen = readExcel(r, 6)
rsBloemen!Lengte = readExcel(r, 7)
rsBloemen!Prijs_Max = FormatComma(readExcel(r, 8))
rsBloemen!Gram = readExcel(r, 9)
rsBloemen!Diameter = readExcel(r, 10)
'Eerste afbeelding automatisch invullen indien als nummer aanwezig
ZoekAfbeelding
rsBloemen.Update
Else
If Val(rsBloemen!regel) > 0 Then '3.
'Nieuw record aanmaken
rsBloemen.AddNew
rsBloemen!regel = readExcel(r, 1)
rsBloemen!Artikelnr = readExcel(r, 2)
rsBloemen!Aantal = readExcel(r, 3)
rsBloemen!OMSCHRIJVING = readExcel(r, 4) + " " + readExcel(r, 5)
rsBloemen!Knoppen = readExcel(r, 6)
rsBloemen!Lengte = readExcel(r, 7)
rsBloemen!Prijs_Max = FormatComma(readExcel(r, 8))
rsBloemen!Gram = readExcel(r, 9)
rsBloemen!Diameter = readExcel(r, 10)
'Afbeelding zoeken
ZoekAfbeelding
rsBloemen.Update
Else
'Bestaand record aanpassen
rsBloemen.Edit
rsBloemen!regel = readExcel(r, 1)
rsBloemen!Artikelnr = readExcel(r, 2)
rsBloemen!Aantal = readExcel(r, 3)
rsBloemen!OMSCHRIJVING = readExcel(r, 4) + " " + readExcel(r, 5)
rsBloemen!Knoppen = readExcel(r, 6)
rsBloemen!Lengte = readExcel(r, 7)
rsBloemen!Prijs_Max = FormatComma(readExcel(r, 8))
rsBloemen!Gram = readExcel(r, 9)
rsBloemen!Diameter = readExcel(r, 10)
'Eerste afbeelding automatisch invullen indien als nummer aanwezig
ZoekAfbeelding
rsBloemen.Update
End If '3. einde
End If '2. einde
Else
'Betstaande combinatie bijwerken
rsBloemen.Edit
rsBloemen!regel = readExcel(r, 1)
rsBloemen!Artikelnr = readExcel(r, 2)
rsBloemen!Aantal = readExcel(r, 3)
rsBloemen!OMSCHRIJVING = readExcel(r, 4) + " " + readExcel(r, 5)
rsBloemen!Knoppen = readExcel(r, 6)
rsBloemen!Lengte = readExcel(r, 7)
rsBloemen!Prijs_Max = FormatComma(readExcel(r, 8))
rsBloemen!Gram = readExcel(r, 9)
rsBloemen!Diameter = readExcel(r, 10)
'Eerste afbeelding automatisch invullen indien als nummer aanwezig
ZoekAfbeelding
rsBloemen.Update
End If '1. einde
HuidReg = HuidReg + 1
Wend
connection. The Excel file has 3315 records. The procedure works fine till
record 2184 and then the procedure stops without debugging information. Is
there a limit of records transfert?
Please help,
Regards,
Dirk Batenburg
The code:
Private Sub cmd_WerkBy_Click()
Dim sZoek As String
Dim tZoek As String
Dim teller As Integer
Dim MaxRegel As Integer
'Database openen
sDBLocation = App.Path & "\BemiddelingsBureau.mdb"
Set dbBloemen = OpenDatabase(sDBLocation)
Set rsBloemen = dbBloemen.OpenRecordset("Bloemen", dbOpenTable)
'Tabel in Access
rsBloemen.Index = "Regelnr"
'On Error Resume Next
Set objExcel = New excel.Application
Set objExlWork = objExcel.Workbooks.Open("D:\Mijn
documenten\Bloemen\Flobase.xls")
'Afsluiten als bestand niet bestaat
If objExlWork Is Nothing Then GoTo ErrorHandler
'Werkblad instellen
Set objSheet = objExlWork.Sheets("Inkoop")
objSheet.Activate
'objExcel.Visible = True 'Excel zichtbaar maken
'Eerste cel activeren
objSheet.Range("A2").Activate
objSheet.Cells.End(xlDown).Activate
MaxRegel = ActiveCell.Row - 1
MsgBox MaxRegel
HuidReg = 2
VorigReg = 2
'r = ActiveCell.Row
bar_Voortgang.Visible = True
bar_Voortgang.Min = 1
bar_Voortgang.Max = MaxRegel
teller = 0
rsBloemen.MoveFirst
While HuidReg < MaxRegel
rsBloemen.Index = "Regelnr"
r = HuidReg
teller = teller + 1
bar_Voortgang.Value = teller
lbl_RegelNr.Caption = teller
lbl_RegelNr.Refresh
sZoek = FormatNr(readExcel(r, 2))
If Len(Trim(sZoek)) = 0 Then GoTo GeenArtKode
tZoek = readExcel(r, 1)
rsBloemen.Seek "=", sZoek, tZoek
If rsBloemen.NoMatch Then '1.
rsBloemen.Index = "Artnummer"
sZoek = FormatNr(readExcel(r, 2))
rsBloemen.Seek "=", sZoek
If rsBloemen.NoMatch Then '2.
'Nieuw record aanmaken
rsBloemen.AddNew
rsBloemen!regel = readExcel(r, 1)
rsBloemen!Artikelnr = readExcel(r, 2)
rsBloemen!Aantal = readExcel(r, 3)
rsBloemen!OMSCHRIJVING = readExcel(r, 4) + " " + readExcel(r, 5)
rsBloemen!Knoppen = readExcel(r, 6)
rsBloemen!Lengte = readExcel(r, 7)
rsBloemen!Prijs_Max = FormatComma(readExcel(r, 8))
rsBloemen!Gram = readExcel(r, 9)
rsBloemen!Diameter = readExcel(r, 10)
'Eerste afbeelding automatisch invullen indien als nummer aanwezig
ZoekAfbeelding
rsBloemen.Update
Else
If Val(rsBloemen!regel) > 0 Then '3.
'Nieuw record aanmaken
rsBloemen.AddNew
rsBloemen!regel = readExcel(r, 1)
rsBloemen!Artikelnr = readExcel(r, 2)
rsBloemen!Aantal = readExcel(r, 3)
rsBloemen!OMSCHRIJVING = readExcel(r, 4) + " " + readExcel(r, 5)
rsBloemen!Knoppen = readExcel(r, 6)
rsBloemen!Lengte = readExcel(r, 7)
rsBloemen!Prijs_Max = FormatComma(readExcel(r, 8))
rsBloemen!Gram = readExcel(r, 9)
rsBloemen!Diameter = readExcel(r, 10)
'Afbeelding zoeken
ZoekAfbeelding
rsBloemen.Update
Else
'Bestaand record aanpassen
rsBloemen.Edit
rsBloemen!regel = readExcel(r, 1)
rsBloemen!Artikelnr = readExcel(r, 2)
rsBloemen!Aantal = readExcel(r, 3)
rsBloemen!OMSCHRIJVING = readExcel(r, 4) + " " + readExcel(r, 5)
rsBloemen!Knoppen = readExcel(r, 6)
rsBloemen!Lengte = readExcel(r, 7)
rsBloemen!Prijs_Max = FormatComma(readExcel(r, 8))
rsBloemen!Gram = readExcel(r, 9)
rsBloemen!Diameter = readExcel(r, 10)
'Eerste afbeelding automatisch invullen indien als nummer aanwezig
ZoekAfbeelding
rsBloemen.Update
End If '3. einde
End If '2. einde
Else
'Betstaande combinatie bijwerken
rsBloemen.Edit
rsBloemen!regel = readExcel(r, 1)
rsBloemen!Artikelnr = readExcel(r, 2)
rsBloemen!Aantal = readExcel(r, 3)
rsBloemen!OMSCHRIJVING = readExcel(r, 4) + " " + readExcel(r, 5)
rsBloemen!Knoppen = readExcel(r, 6)
rsBloemen!Lengte = readExcel(r, 7)
rsBloemen!Prijs_Max = FormatComma(readExcel(r, 8))
rsBloemen!Gram = readExcel(r, 9)
rsBloemen!Diameter = readExcel(r, 10)
'Eerste afbeelding automatisch invullen indien als nummer aanwezig
ZoekAfbeelding
rsBloemen.Update
End If '1. einde
HuidReg = HuidReg + 1
Wend