export 10000 rec in txt files (2500 rec per file)

Palmpjes · 22 mei 2006

In onderstaande code probeer ik een tabel te exporteren in txtbestanden van 2500 rec per stuk.
Ik heb deze code in afgeslankte vorm geprobeerd en die werkte.
Nu wil ik via keuzelijsten in een form zorgen dat de een aantal dingen gekozen kunnen worden.

Ik krijg een foutmelding dat sub of function niet gedefinieerd is.
en stopt mij de eerste RS.
Wat doe ik fout !!

Sub exporteren()

Dim tblnm As String

SQL = "INSERT INTO Export" & counter & " SELECT * FROM " & tblnm & "WHERE ID = " & rs("ID")
padvar = "H:\CIP_BESTANDEN\BETREG\Spoolbestanden\"
tblnm = Me.tabelKeuzelijst

Set rs = CurrentDb.OpenRecordset("SELECT * FROM " & tblnm)
i = 0
counter = 0
' loop door Table1
Do While Not rs.EOF
' om de 2500 records (en bij begin)
If i Mod 2500 = 0 Then
' pas na 2500 records
If counter > 0 Then
' aangemaakte tabel met 2500 records exporteren
DoCmd.TransferText acExportDelim, , "Export" & counter, padvar & "Spoolbestanden" & counter & ".txt", True
' aangemaakte tabel wissen
CurrentDb.Execute "DROP TABLE Export" & counter
End If
counter = counter + 1
' 1e record naar nieuwe tabel kopieren
CurrentDb.Execute "SELECT * INTO Export" & counter & " FROM tblAppBetReg WHERE ID = " & rs("ID")
i = i + 1
rs.MoveNext
If rs.EOF Then Exit Do
End If
' record naar tabel kopieren
CurrentDb.Execute SQL
i = i + 1
rs.MoveNext
Loop
Set rs = Nothing
DoCmd.TransferText acExportDelim, , "Export" & counter, padvar & "Spoolbestanden" & counter & ".txt", True
CurrentDb.Execute "DROP TABLE Export" & counter

End Sub

Joep Meloen · 23 mei 2006

Verwijzingen

Alle benodigde verwijzingen aangevinkt....................?

Groeten,

Joop

Palmpjes · 23 mei 2006

Joep Meloen zei:
Alle benodigde verwijzingen aangevinkt....................?

Groeten,

Joop

Hallo Joop,

Alle verwijzingen staan aan.

kleine aanpassing gedaan, RS variabel gemaakt, die slaat ie nu over maar blijft nu hangen
tblnm = Me.tabelKeuzelijst, me zou een ongeldig gebruik van het sleutelwoord ME zijn.
Geen idee wat er nu weer mis gaat. tabelKeuzelijst bestaat wel.

Na bijwerken op keuzelijst is
Private Sub tabelKeuzelijst_AfterUpdate()
Me.tabelKeuzelijst
End Sub

Er begint me wel iets te dagen. Ik heb onderstaande code in een module staan.

Me.tabelKeuzelijst staat op een formulier genaamd Tekstbestand_importeren_en_of_exporteren
Volgens mij moet dan de verwijzing naar de tabelKeuzelijst anders.
Weet jij hoe ik dat moet doen ?
Ook Sub exporteren() als naam van de module ... is dat ook goed ?
Mijn VBA kennis is nog niet erg goed dus vandaar mijn vragen.

======================================================
Sub exporteren()

Dim tblnm As String
Dim i, counter As Long
Dim SQL, padvar As String
Dim RS As Recordset

SQL = "INSERT INTO Export" & counter & " SELECT * FROM " & tblnm & " WHERE ID = " & RS("ID")
padvar = "H:\CIP_BESTANDEN\BETREG\Spoolbestanden\"
tblnm = Me.tabelKeuzelijst

Set RS = CurrentDb.OpenRecordset("SELECT * FROM " & tblnm)
i = 0
counter = 0
' loop door Table1
Do While Not RS.EOF
' om de 2500 records (en bij begin)
If i Mod 2500 = 0 Then
' pas na 2500 records
If counter > 0 Then
' aangemaakte tabel met 2500 records exporteren
DoCmd.TransferText acExportDelim, , "Export" & counter, padvar & "Spoolbestanden" & counter & ".txt", True
' aangemaakte tabel wissen
CurrentDb.Execute "DROP TABLE Export" & counter
End If
counter = counter + 1
' 1e record naar nieuwe tabel kopieren
CurrentDb.Execute "SELECT * INTO Export" & counter & " FROM tblAppBetReg WHERE ID = " & RS("ID")
i = i + 1
RS.MoveNext
If RS.EOF Then Exit Do
End If
' record naar tabel kopieren
CurrentDb.Execute SQL
i = i + 1
RS.MoveNext
Loop
Set RS = Nothing
DoCmd.TransferText acExportDelim, , "Export" & counter, padvar & "Spoolbestanden" & counter & ".txt", True
CurrentDb.Execute "DROP TABLE Export" & counter

End Sub

Joep Meloen · 23 mei 2006

foutjes...........

Je moet in een module verwijzen naar het besturingselement als volgt:
Forms![NaamVanJeFormulier]![NaamVanJe Besturingselement]

De module moet een (Public) Function worden. Gebruik nooit een gereserveerde naam voor je functie.

succes!

Joop

Palmpjes · 24 mei 2006

Joep Meloen zei:
Je moet in een module verwijzen naar het besturingselement als volgt:
Forms![NaamVanJeFormulier]![NaamVanJe Besturingselement]

De module moet een (Public) Function worden. Gebruik nooit een gereserveerde naam voor je functie.

succes!

Joop

Helaas na een aantal dagen stoeien zie ik door de bomen het bos helaas niet meer.
Ik heb nu de foutmeldingen blokvariabele niet gedefinieerd.
Bij
SQL = "INSERT INTO Export" & counter & " SELECT * FROM " & tblnm & " WHERE ID = " & RS("ID")

of hij begint te zeuren over End With.

Code is nu als volgt
-----------------------------------------------------------------------------------
Function exp()

Dim tblnm As String
Dim i, counter As Long
Dim SQL, padvar As String
Dim RS As DAO.Recordset

padvar = "H:\CIP_BESTANDEN\BETREG\Spoolbestanden\"
tblnm = Forms![TekstbestandImporterenEnOfExporteren]![tabelKeuzelijst]
SQL = "INSERT INTO Export" & counter & " SELECT * FROM " & tblnm & " WHERE ID = " & RS("ID")

Set RS = CurrentDb.OpenRecordset("SELECT * FROM " & tblnm)
With RS
i = 0
counter = 0
' loop door Table1
Do While Not RS.EOF
' om de 2500 records (en bij begin)
If i Mod 2500 = 0 Then
' pas na 2500 records
If counter > 0 Then
' aangemaakte tabel met 2500 records exporteren
DoCmd.TransferText acExportDelim, , "Export" & counter, padvar & "Spoolbestanden" & counter & ".txt", True
' aangemaakte tabel wissen
CurrentDb.Execute "DROP TABLE Export" & counter
End If
counter = counter + 1
' 1e record naar nieuwe tabel kopieren
CurrentDb.Execute "SELECT * INTO Export" & counter & " FROM tblAppBetReg WHERE ID = " & RS("ID")
i = i + 1
RS.MoveNext
If RS.EOF Then Exit Do
End If
' record naar tabel kopieren
CurrentDb.Execute SQL
i = i + 1
RS.MoveNext
Loop
Set RS = Nothing
DoCmd.TransferText acExportDelim, , "Export" & counter, padvar & "Spoolbestanden" & counter & ".txt", True
CurrentDb.Execute "DROP TABLE Export" & counter

End Function

thomrob · 25 mei 2006

haal 'With RS ' eens weg uit je code.

dit blok wordt afgesloten met end with, wat je niet hebt gedaan. Omdat je de with toch niet gebruikt in je procedure kun je het weglaten.

gregorg · 26 mei 2006

Code:

Public Function proberen()
Dim rst As ADODB.Recordset
Dim fs As Scripting.FileSystemObject
Dim f As Scripting.TextStream
Dim fld As ADODB.Field
Dim i As Integer
Dim a As Integer
Const nr = 100
On Error Resume Next

Set rst = New ADODB.Recordset
Dim strX As Variant
rst.Open "Customers", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
Set fs = CreateObject("Scripting.FileSystemObject")

Do Until rst.EOF
strX = vbNullString
i = i + nr
    If i Mod nr = 0 Then
    Set f = fs.CreateTextFile("Export" & i & ".txt")
        For Each fld In rst.Fields
        f.Write fld.Name & vbTab
        Next
        f.Write vbNewLine
    End If
strX = rst.GetString(, nr, vbTab, vbNewLine)
'On Error GoTo fout
f.Write strX
f.Close
Loop

rst.Close
Set rst = Nothing
Set f = Nothing
Set fs = Nothing
exitfout:
Exit Function

fout:
MsgBox Err.Number & Err.Description
Resume exitfout:

End Function

Ik dacht je een oplossing te kunnen geven die gebruik maakt van andere technieken.
Dit werkt goed behalve voor de loop waar het getal 1500 in voor komt. Dus als je een aantal van 100 pakt is export1500 leeg en als je getal 1400 invoert is 2800 leeg.
Ik kan het niet vinden waar dat aan ligt? Misschien weet iemand dat.

Gregor

thomrob · 26 mei 2006

debuggen

dit is kant en klare code gregorg en ik denk niet dat iemand hier zin heeft dit te debuggen, behalve palmpjes zelf. Wij lezen hopelijk dan wel wat de oplossing is.

Tardis · 26 mei 2006

Gregor,

kijk eens naar dit artikel in de Microsoft Knowledge Base, het lijkt jouw vraag te beantwoorden:

http://support.microsoft.com/kb/209940/EN-US/

Tardis

gregorg · 26 mei 2006

Dat het aan een instelling ligt vermoedde ik al maar of het deze dat vraag ik mij af. Ik krijg ook niet de specifiek genoemde de foutmelding.

Als je on error resume next weghaalt dan gaat hij fout op de regel

f.Write strX
Ongeldige procedure aanroep of argument. Dat doet hij in de loop waarin het 1500-ste record voorkomt. Vervolgens gaat hij weer door. En komt de foutmelding niet meer.(ik gebruik als test een tabel met 2800 records. Wat zou hij doen bij 3000?)

Gregor

thomrob · 26 mei 2006

is strX niet een lege string?

anders even controleren met if len(strX)=0...

gregorg · 27 mei 2006

probeer het maar eens

heb ik al gecontroleerd. Is niet zo.
Ik heb het geprobeerd met 9000 records postcodetabel en daar doet hij het niet??????
Kan geen bijlage posten anders kon je het zelf eens testen.

Gregor

Palmpjes · 27 mei 2006

Lezers,

Dankzij ander forum (www.paulsnip.nl) :thumb: heb ik de oplossing verkregen.
Het was niet makkelijk maar na wat aanwijzingen en aanpassingen heb ik onderstaande code. De snelheid kan wel iets beter maar sowieso is txt bestanden aanmaken via de wizard ook niet 1 van de snelste akties.
Wie daar nog een oplossing voor heeft dan hoor ik dat graag uiteraard

Het laatste waar ik nu nog mee bezig ben is om de exportnaam met datum er in te krijgen.
Anders overschrijft ie de reeds eerder aangemaakte bestanden omdat ie telkens met volgnummer 1 begint. Ook bedenk ik me ineens dat een variabele kan worden gemaakt gekoppeld aan een inputveld. Dat lijkt me een nog beter idee en bied de eindgebruiker de mogelijkheid om zelf een naam te kiezen.

Hierbij de code
=============================================================
Function exp()

Dim tblnm, SpecificatieSoort As String
Dim i, counter As Long
Dim SQL, padvar As String
Dim RS As DAO.Recordset

padvar = Forms![TekstbestandImporterenEnOfExporteren]![directoryExportkzl]
tblnm = Forms![TekstbestandImporterenEnOfExporteren]![tabelKeuzelijst]
SpecificatieSoort = Forms![TekstbestandImporterenEnOfExporteren]![kzlstSpec]

Set RS = CurrentDb.OpenRecordset("SELECT * FROM " & tblnm)
i = 0
counter = 0
' loop door Table1
Do While Not RS.EOF
' om de 2500 records (en bij begin)
If i Mod 2500 = 0 Then
' pas na 2500 records
If counter > 0 Then
' aangemaakte tabel met 2500 records exporteren
DoCmd.TransferText acExportDelim, SpecificatieSoort, "Export" & counter, padvar & "Spoolbestanden" & counter & ".txt", True
' aangemaakte tabel wissen
CurrentDb.Execute "DROP TABLE Export" & counter
End If
counter = counter + 1
' 1e record naar nieuwe tabel kopieren
CurrentDb.Execute "SELECT * INTO Export" & counter & " FROM tblAppBetReg WHERE ID = " & RS("ID")
i = i + 1
RS.MoveNext
If RS.EOF Then Exit Do
End If
' record naar tabel kopieren
SQL = "INSERT INTO Export" & counter & " SELECT * FROM " & tblnm & " WHERE ID = " & RS("ID")
CurrentDb.Execute SQL
i = i + 1
RS.MoveNext
Loop
Set RS = Nothing
DoCmd.TransferText acExportDelim, SpecificatieSoort, "Export" & counter, padvar & "Spoolbestanden" & counter & ".txt", True
CurrentDb.Execute "DROP TABLE Export" & counter

MsgBox "Uw Textbestanden zijn klaar ! ", vbOKOnly, "Exporteren"
End Function
===============================================================

export 10000 rec in txt files (2500 rec per file)

Palmpjes

Gebruiker

Joep Meloen

Gebruiker

Palmpjes

Gebruiker

Joep Meloen

Gebruiker

Palmpjes

Gebruiker

thomrob

Gebruiker

gregorg

Gebruiker

thomrob

Gebruiker

Tardis

Terugkerende gebruiker

gregorg

Gebruiker

thomrob

Gebruiker

gregorg

Gebruiker

Palmpjes

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy