FileSystemObject .AtEndOfStream merkt het einde v.d.tekst niet op

Status
Niet open voor verdere reacties.
A

AMBERTJE

Gebruiker
Lid geworden
27 aug 2009
Berichten
121
Hi iedereen,

In een Access 2003 DB wil ik met het FyleSystemObject een Teksbestand inlezen in een tabel.
Eerst duid ik de file aan die ik wil inlezen via een absoluut path.
varData is de Array waar ik 11 velden (FaVelden) in stop omdat mijn bestand ook 11 velden heeft.
Elk veld in het textbestand is afgesloten door een pipe |
Alles loopt echt heel goed tot de loop aan de laatste ingevulde lijn komt, deze wordt nog ingelezen in varData tot het laatste veld.
Maar dan als de loop moet stoppen omdat het de laatste lijn is komt de foutboodschap: Run-time error '9' Subscript out of range

Ik heb al zoveel uitgeprobeerd maar zonder hulp raak ik er zelf niet uit. De code heb ik uit macro's gehaald die anderen hadden geschreven, het meeste kan ik verklaren maar niet (FaVelden -1) misschien dat iemand anders het wel ziet?

Ik ben nog niet gekomen aan het daadwerkelijk importeren naar een tabel via een RecordSet omdat ik hier al ben vastgelopen.

Kan iemand me bij deze macro helpen aub? Ik heb ook een klein .txt bestandje toegevoegd

Code: 
Option Compare Database
Option Explicit

Private Const FaDelim As String = "|"
Private Const FaVelden As Byte = 11

Public Function ImportFA() As Boolean
    Dim fd As FileDialog, strBestand As String
    'Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogOpen)
    'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim varSelectedItem As Variant

    'Use a With...End With block to reference the FileDialog object.
    With fd
        'Set the initial path to the drive where the file exists.
        .InitialFileName = A:\Bestanden\
        'Don't allow the selection of multiple files.
        .AllowMultiSelect = False
        'Change the title of the dialog
        .Title = "Kies het FA bestand: "
        'Use the Show method to display the File Picker dialog box and return the user's action.
        'The user pressed the action button.
        Select Case .Show
            Case False
                Set fd = Nothing
                Exit Function
        End Select
            'Step through each string in the FileDialogSelectedItems collection
            For Each varSelectedItems In .SelectedItems
                MsgBox "Bestand is geselecteerd"
                Next varSelectedItems
            strBestand = .SelectedItems(1)
    End With
    Set fd = Nothing
    
    'Feitelijk inlezen van het bestand:
    Dim fso As FileSystemObject, f As TextStream, varData() As Variant
    Dim L As Long, i As Integer, strLijn() As String
    'The following code illustrates how the FileSystemObject is used to return a TextStream object that can be read from or written to:
    Set fso = New FileSystemObject
    Set f = fso.OpenTextFile(strBestand)
        'per record wordt de data veld per veld ingevuld
        'Store|FTT|Route|Stop|FSP|Aant_Pal|Sel_Method|Total_Volume|Total_Weight|Aant_Prod|Aant_Collis
        '10544|KKK|3702 | 1  |400|   1    |     S    |    0.239   |    74.70   |    26   |      28
        '10544|YYY|3702 | 1  |400|   1    |     S    |    0.487   |   135.36   |    41   |      56
        With f
            Do While .AtEndOfStream <> True
                ReDim Preserve varData(0 To (FaVelden -1), 0 To L)
                strLijn = VBA.Split(.ReadLine, "|")
                For i = 0 To (FaVelden -1)
                    varData(i, L) = strLijn(i)
                Next
                L = L + 1
            Loop
            .Close
        End With
    Set fso = Nothing
    Set f = Nothing
    
End Function

Groetjes,
Monique
 

Bijlagen

Laatst bewerkt:
Je code doet het, maar als je de variabelen checkt zul je zien dat je een naamfoutje hebt gemaakt.

Dim varSelectedItem As Variant
For Each varSelectedItems In .SelectedItems

Ik krijg overigens ook geen foutmelding als ik de code doorloop, met (dat dan wel) de juiste variabelenaam :) )
 
Hoi Michel,

Bedankt voor uw snelle reactie, zelfs na het corrigeren van de variabele blijf ik de foutmelding krijgen nadat de laatste lijn is ingelezen.
Snap echt niet wat er aan de hand is :confused:

grtjs,
Ambertje
 
Heb je dezelfde variabele die achter next staat ook aangepast? Daar staat ook een s teveel.
 
Ja michel, die is ook aangepast. Misschien mis ik een library, daar ga ik nu eens naar kijken.
Grtjs,
Ambertje
 
OctaFish zei:
Je code doet het, maar als je de variabelen checkt zul je zien dat je een naamfoutje hebt gemaakt.

Dim varSelectedItem As Variant
For Each varSelectedItems In .SelectedItems

Ik krijg overigens ook geen foutmelding als ik de code doorloop, met (dat dan wel) de juiste variabelenaam :) )
Klik om te vergroten...

Michel,

Het bestand dat ik heb meegestuurd was een verkorte versie.
Als ik de originele versie bekijk zie ik dat er na de laatste regel nog enkele blanco regels komen en ik denk dat hij daar op flipt.
Ik post een origineel bestandje met de lege lijnen, zou je dit eens kunnen testen aub?
Als jij dit ook ondervindt weet je dan hoe ik dit in de code moet aanpassen zodat dit geen issue meer is?

Grtjs,
Ambertje
 
Dan nu het bestand met de lege rijenBekijk bijlage FA231432.txt
Dit bestand komt dagelijks in die format binnen via FTP van een andere server, elke dag de lege lijnen deleten is niet de bedoeling.

Grtjs,
Ambertje
 
Laatst bewerkt:
Zal het eens uittesten!
 
Je kunt het wel afvangen, bijvoorbeeld zo:

Code: 
    With fts
        Do While Not .AtEndOfStream
            ReDim Preserve varData(0 To (FaVelden), 0 To L)
            tmp = .ReadLine
            If Trim(tmp) = "" Then
                Exit Function
            End If
            strLijn = Split(tmp, "|")
            For i = 0 To (FaVelden)
                varData(i, L) = strLijn(i)
            Next
            L = L + 1
        Loop
        .Close
    End With
 
Hoi Michel,

Bedankt voor de tip, kun je mij ook uitleggen hoe ik dit in de code moet aanpassen.
Je gebruikt een nieuwe variabele tmp en een nieuw filesystemobject, moet ik deze dan ook aanmaken en integreren in de loop of is dit een aanpassing van de bestaande loop?

Zelf heb ik al verschillende malen geprobeerd de code aan te passen aan uw richtlijnen maar zonder succes.

Grtjs,
Ambertje
 
Dit is de volledige code van de functie:

Code: 
Public Function ImportFA() As Boolean
Dim varSelectedItem As Variant, varData() As Variant
Dim fso As FileSystemObject
Dim fd As FileDialog, strBestand As String
Dim fts As Scripting.TextStream
Dim L As Long, i As Integer, strLijn() As String
[B]Dim tmp As Variant[/B]

    'Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogOpen)
    With fd
        .InitialFileName = "E:\Mijn documenten\_HelpMij\_MS Access\Ambertje\"
        .AllowMultiSelect = False
        .Title = "Kies het FA bestand: "
        Select Case .Show
            Case False
                Set fd = Nothing
                Exit Function
        End Select
        strBestand = .SelectedItems(1)
    End With
    Set fd = Nothing
    
    Set fso = New FileSystemObject
    Set fts = fso.OpenTextFile(strBestand)
    'per record wordt de data veld per veld ingevuld
    'Store|FTT|Route|Stop|FSP|Aant_Pal|Sel_Method|Total_Volume|Total_Weight|Aant_Prod|Aant_Collis
    '10544|KKK|3702 | 1  |400|   1    |     S    |    0.239   |    74.70   |    26   |      28
    '10544|YYY|3702 | 1  |400|   1    |     S    |    0.487   |   135.36   |    41   |      56
    With fts
        Do While Not .AtEndOfStream
            ReDim Preserve varData(0 To (FaVelden), 0 To L)
            tmp = .ReadLine
            If Trim(tmp) = "" Then
                Exit Function
            End If
            strLijn = Split(tmp, "|")
            For i = 0 To (FaVelden)
                varData(i, L) = strLijn(i)
            Next
            L = L + 1
        Loop
        .Close
    End With
    
    Set fso = Nothing
    Set fts = Nothing
    
End Function
Zoals je gezien hebt, heb ik een extra variabele gemaakt die eerst de importregel inleest. Op basis van die variabele wordt een check uitgevoerd. Op zich zou dat ook rechtsreeks moeten kunnen, maar ik werk liever met een aparte variabele, omdat je in de Stapmodus, als je regel voor regel door de code loopt, dan kunt controleren of de regel juist wordt ingelezen. En dat werkt dus :)
 
Hartelijk dank Michel,

Het lukt perfect nu, ik heb echter nog 1 klein verzoekje:
Deze code is natuurlijk nog niet af en voor ik verder ga wil ik alles goed testen.
Ken een routineke dat ik kan ik gebruiken om aan het einde te zien hoeveel lijnen er zijn ingelezen?
Nu loopt de code af en het local window is dan helemaal leeg.

Ik heb al een aantal maal debug.print zien staan in andere hun code maar weet niet hoe dit werkt, misschien een test subke?

Grtjs,
Ambertje
 
Debug.Print is niet heel nuttig, omdat je daarmee in het venster Direct gegevens kunt lezen, en verder niks. Ik heb zelf in deze code getest met een nummer variabele die je steeds met 1 verhoogt bij het inlezen van de regels. Omdat ik wilde weten op welke regel het importeren eventueel fout zou gaan.
Die zet je bijvoorbeeld hier neer:
Code: 
            strLijn = Split(tmp, "|")
            teller=teller+1
            For i = 0 To (FaVelden)
De variabele teller kun je dan in een msgbox laten zien.
 
Michel,

Bedankt voor de tip :thumb:.

Ik kom toch nog een probleem tegen, Op de regel .Close (na de loop) zouden alle rijen met gegevens in het geheugen moeten blijven (om ze nadien in een tabel te kunnen toevoegen).
Dit gebeurt echter niet, ik heb de code verder opgebouwd zodat elke lijn dmw een recordset in de velden van de tabel worden geplaatst.
Na afloop van de loop zijn alle gegevens weg en kan ik niets doen met de recordset.

Ben ik nog iets vergeten? :confused:

Groetjes,
Ambertje
 
Michel,

Bedankt voor de tip :thumb:.

Ik kom toch nog een probleem tegen, Op de regel .Close (na de loop) zouden alle rijen met gegevens in het geheugen moeten blijven (om ze nadien in een tabel te kunnen toevoegen).
Dit gebeurt echter niet, ik heb de code verder opgebouwd zodat elke lijn dmw een recordset in de velden van de tabel worden geplaatst.
Na afloop van de loop zijn alle gegevens weg en kan ik niets doen met de recordset.

Ben ik nog iets vergeten? :confused:

Groetjes,
Ambertje
 
Hmmmmmm ik denk dat ik het gevonden heb, als we het einde bereikt hebben en de string is leeg dan gaan we zonder pardon uit de functie.

Wat lastig is natuurlijk omdat ik daar niet de hele code hieronder vermeld kan integreren.
Een andere functie maken voor het overzetten van de data naar een tabel is ook geen oplossing want dan zijn de locale variabelen waar we mee telden niet gekend.
Code: 
Public Function ImporteerNaarTabel()
'Updaten van Tbl_Fa
Dim strSQL As String, rst As DAO.Recordset DBEngine.BeginTrans
    On Error GoTo FOUT
    strSQL = "DELETE * from Tbl_Fa"
    CurrentDb.Execute strSQL
    
    strSQL = "SELECT * from Tbl_Fa where 0 = 1"
    Set rst = CurrentDb.OpenRecordset(strSQL)
    
    With rst
        For L = LBound(varData, 2) To UBound(varData, 2)
            .AddNew
            .Fields("Store").Value = varData(0, L)
            .Fields("FTT").Value = varData(1, L)
            .Fields("Route").Value = varData(2, L)
            .Fields("Stop").Value = varData(3, L)
            .Fields("FSP").Value = varData(4, L)
            .Fields("Aant_Pal").Value = varData(5, L)
            .Fields("Sel_Method").Value = varData(6, L)
            .Fields("Total_Volume").Value = varData(7, L)
            .Fields("Total_Weight").Value = varData(8, L)
            .Fields("Aant_Prod").Value = varData(9, L)
            .Fields("Aant_Collis").Value = varData(10, L)
            .Update
        Next
    End With
    DBEngine.CommitTrans
    ImportFA = True
    MsgBox "Import pbl MSI succesvol"
    
    Exit Function
FOUT:
    DBEngine.Rollback
    MsgBox "Probleem met de import ! Niets geïmporteerd." + vbCrLf + _
            VBA.Err.Description

End Function

Hoe moet ik nu verder?
 
Ik zou vermoed ik toch een tijdelijke tabel maken in de db, waar je de waarden in wegschrijft. Deze kun je dan weggooien als hij niet meer nodig is. Ik ben zelf ook nog bezig met uit te zoeken of, en zo ja: hoe je een onafhankelijke recordset elders in de db kunt gebruiken. Maar daar ben ik ook nog niet uit...
 
Hoi Michel,

Ik ben al iets verder geraakt, ik heb de variabelen L en varData() globaal geplaatst zodat ze ook herkend worden door de functie ImporteerNaarTabel.


Code: 
            If Trim(tmp) = "" Then
                Exit Function
            End If
Dit stukje code veranderd in
Code: 
            If Trim(tmp) = "" Then
               Call ImporteerNaarTabel
            End If

Het resultaat is dat de gegevens nu wel onthouden blijven maar nog niet weggeschreven worden omdat het subscript out of range is.
Een ander probleem ontstaat bij:
Code: 
ImportFa = True
Hier krijg ik de error: Function call on left-hand side of assignment must return Variant or Object
Als ik hier op google krijg ik tegenstrijdige informatie.

Grtjs,
Monique
 
Kun je de laatste versie nog een keer posten? Dan zien we waar hij op stuk loopt.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan