Ανανέωση ιστοσελίδας

[Meteora]

Καλημέρα...

Ο παρακάτω κώδικας κάνει τη δουλειά που θέλω. Όμως ο έλεγχος και η γνώμη φίλων-μελών του Forum είναι -στη παρούσα περίπτωση- α ν α γ κ α ί α.
Στόχος της ρουτίνας είναι να εισάγει στήλες με δεδομένα από φύλλο Excel σε πέντε (5) διαφορετικούς πίνακες. (παράδειγμα 1η, 5η, 6η, 7η στήλη στον πίνακα tblKatigites1...κ.ο.κ).
Κάθε εναλλακτική λύση ευπρόσδεκτη.

private sub ALFA()
Dim thepath1$
      thepath1="C:/arxeiakat/test.xls"

    With OpenDatabase(thepath1, False, True, "Excel 8.0;HDR=Yes;")
        Set rs = .OpenRecordset("QryOla$")   ' QryExcel είναι το φύλλο Excel (πηγή data)
        If rs.RecordCount Then
        rs.MoveFirst
            InsertKat1 thepath1, rs 
        rs.MoveFirst
            InsertKat2 thepath1, rs  
         κλπ  
        End If
    End With
end sub

Private Sub InsertKat1(thePath As String, rs As Object)

    Dim rcd As Object
    Set rcd = CurrentDb.OpenRecordset("tblKatigites1", 2)    
    Do While Not rs.EOF
        With rcd
            If IsNull(rs.Fields(2)) Then Exit Do
            .AddNew
            !ΑΜ = rs.Fields(6)
            !Γεννηση = rs.Fields(11)
     και άλλα πεδία
            !Διδακτορικο = rs.Fields(24)
            .Update
        End With
        rs.MoveNext
    Loop
    rcd.Close
    Set rcd = Nothing
End Sub

Ευχαριστώ / Νίκος Δ.

Υστερολόγιο : Να τονίζω οτι οι στήλες Excel δεν είναι συνεχόμενες. Η ρουτίνα που σας παρουσιάζω μεταφέρει υλικό μόνο σε ένα πίνακα...

[nisgia]

Καλησπέρα σε όλη τη παρέα!

Φίλε Νίκο, δοκίμασε αν θέλεις και την παρακάτω διαδικασία:

Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub Test()
    Dim strSQL As String
    Dim lngStart As Long
    Dim lngRecs As Long
    
    On Error GoTo ErrHandler
    DoCmd.SetWarnings False
    strSQL = "Insert Into Table1 (DataField2, DataField4) " _
        & "Select Column1, Column4 From " _
        & "[Excel 8.0;HDR=Yes;Database=C:\Test.xls].[DataSheet$];"
    lngStart = GetTickCount
    CurrentProject.Connection.Execute strSQL, lngRecs
    MsgBox lngRecs & " records added in Table1 in " _
        & (GetTickCount - lngStart) & " milliseconds!", vbInformation
ExitProc:
    DoCmd.SetWarnings True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitProc
End Sub

DataField2 και DataField4 είναι δυο από τα πεδία του πίνακα Table1 στα οποία προσαρτώνται τα δεδομένα από τις στήλες Column1 και Column4 του C:\Test.xls.
Στη θέση του ονόματος του φύλλου DataSheet$ μπορεί να μπεί το όνομα μιας περιοχής κελιών του βιβλίου εργασίας χωρίς όμως το τελικό $. Αυτό απαιτείται μόνο σε αναφορές ονομάτων φύλλων εργασίας.

Αν λοιπόν την προικίσεις με τα κατάλληλα ορίσματα, μπορεί εύκολα να μετατραπεί σε μια διαδικασία γενικής χρήσης.

Φαντάζομαι πως αυτή η μέθοδος θα είναι αρκετά πιο γρήγορη από τη χρήση βρόχων ειδικά με μεγάλους όγκους δεδομένων.
Η ύπαρξη της GetTickCount στο παραπάνω παράδειγμα είναι για τη χρονική ενημέρωσή μας και μόνο.
Στο σύστημα τουλάχιστον που βρίσκομαι, χρειάστηκε περίπου 0,6 δευτερόλεπτο για την προσάρτηση 50000 εγγραφών.

Δοκίμασέ τη και τα ξαναλέμε.
Ελπίζω να σ' αρέσει!

Φιλικά, Γιάννης.

Υ.Γ.
Είδες όμως με τι μαστοροχωρίτικο τρόπο απέφυγα το "...να σου αρέσει";

[Meteora]

Γιάννη μου σε ευχαριστώ θερμά !
Δεν μπορώ να πιστέψω οτι ο κώδικας που βλέπω μπορεί να κάνει την μεταφορά excel προς Access... α π ί σ τ ε υ τ ο.
Γιάννη με τη πρώτη γραμμή τι γίνεται ; ...πάω για δοκιμή. Θα επανέλθω...
Έχεις τη φιλία μου / Νίκος

[Tasos]

Καλησπέρα Νίκο και Γιάννη!

Νίκο, όσον αφορά την πρώτη γραμμή που ανέφερες, βρες στον κώδικα:

το HDR=Yes
και αντικατέστησε το με
το HDR=Νο


Τα λέμε


Τάσος

[Meteora]

Τάσο καλησπέρα...
Ο Γιάννης όπως πάντα SuperNova ! Θα επανέλθει σε ...εύλογο χρονικό διάστημα. Ο κώδικας "κλωτσάει" ζητά ορισμό μιας επιπλέον παραμέτρου...
Ψάχνω...

strSQL = "Insert Into tblipodoxi  (Eidos, AFM) " _
        & "Select Column2, Column4 From " _
        & "[Excel 8.0;HDR=Yes;Database=C:\Users\Νίκος\Desktop\EFORIA.xls].[QryExcel$];"

Τι δεν ερμήνευσα σωστά ;

Τάσο ευχαριστώ.

[Tasos]

Καλησπέρα!
Μου έρχονται στο μυαλό 2 περιπτώσεις:

Με χρήση του HDR=yes: Δεν υπάρχουν τα ονόματα των στηλών του Excel στο strSQL.

Με χρήση του HDR=Νο: Θα πρέπει αντί για τα ονόματα των στηλών του Excel να δώσεις:

F1, F2; F4 κτλ. (το γράμμα F και τον αριθμό της στήλης).

Επίσης, οι μορφοποιήσεις στου πίνακες Access και Excel πρέπει να ταιριάζουν.

Τάσος

[Meteora]

Τάσο μου, το θέμα έκλεισε ! ( 15 msec για μεταφορα περίπου 1000 εγγραφών).
Ευχαριστώ φίλε μου.

Νίκος Δ.

Υστερολόγιο : Γιάννη μου ο χρόνος ...μεγάλος με φαίνεται !!!

[Tasos]

Αρχική Δημοσίευση από Meteora

...Υστερολόγιο : Γιάννη μου ο χρόνος ...μεγάλος με φαίνεται !!!

...Για ένα SuperNova τα 15 msec είναι πολλά!

[nisgia]

Τελικά φίλοι μου, στον κόσμο των υπολογιστών, ακόμη και για έναν SuperNova , τα 15 msec είναι πολλά!

Μετά από μερικές δοκιμές (αντίθετα με ό,τι αρχικά φαντάστηκα), διαπίστωσα πως η παραπάνω μέθοδος είναι πιο αργή
από τη χρήση βρόχων με αντικείμενα Recordset και πως η διαφορά τους σε απόδοση είναι ανάλογη του όγκου δεδομένων.

Από τις τρεις μεθόδους που θα βρείτε στο συνημμένο αρχείο (TestTransferMethods.mdb), η πιο γρήγορη φαίνεται να είναι η TransferSpreadsheet
του αντικειμένου DoCmd όμως μειονεκτεί σε σχέση με τις άλλες στην ελευθερία διαχείρισης των εμπλεκόμενων στηλών και πεδίων.

Για να μπορέσετε να τρέξετε τη διαδικασία TestSpeed της λειτουργικής μονάδας Module1 του αρχείου TestTransferMethods.mdb,
ακολουθήστε τα εξής βήματα:

• Κατεβάστε και αποσυμπιέστε τον συνημμένο φάκελο (TestTransferMethods.zip) στον υπολογιστή σας.
• Ανοίξτε το βιβλίο εργασίας Test.xls και συμπληρώστε τα δεδομένα πατώντας το κουμπί "ΟΚ".
• Κλείστε το Test.xls, και τρέξτε τη μόνη διαδικασία του TestSpeedTransferData.mdb.

Τα αποτελέσματα θα εμφανιστούν στο παράθυρο Immediate του VBA.
Μην ξεχνάτε να καθαρίζετε τα δεδομένα από τον πίνακα Table1 της βάσης γιατί γεμίζει γρήγορα!

Καλή σας μέρα!
Γιάννης

[Tasos]

Καλησπέρα κι από μένα!

Η γνώμη μου είναι ότι σε διαδικασίες γραφής/ανάγνωσης δεδομένων της Excel,
κανένας οδηγός και καμία μέθοδος δεν μπορεί να είναι γρηγορότερη από την ίδια την Excel (Range Object),
ειδικά αν πρόκειται για πολλές χιλιάδες εγγραφών.

Μ αυτό το σκεπτικό, θα πρότεινα τον παρακάτω κώδικα που μπορεί να δουλέψει μέσα από το *.mdb αρχείο του Γιάννη μας (SuperNova ).

Ο χρόνος εκτέλεσης του σε Windows Xp και με Office 2003 περιορίζεται στο 45 - 50% περίπου του χρόνου που χρειάζεται με την TransferSpreadsheet.

Επίσης, μας επιτρέπει να ορίσουμε όποιο φύλλο και όποια περιοχή του φύλλου θελήσουμε να εισαχθεί
σε πίνακα της Access:

Option Compare Database
Option Explicit
Declare Function GetTickCount Lib "kernel32" () As Long

Sub ImportFromExcel()
    Dim MyArray, _
            lngStart As Long, _
            y As Long, _
            strTestFile As String
    lngStart = GetTickCount
    strTestFile = CurrentProject.Path & "\Test.xls"
    MyArray = GetXLArray(strTestFile, "DataSheet", "A2:D30000") ' or "myRange"
    With CurrentDb.OpenRecordset("Table1", dbOpenDynaset)
        For y = LBound(MyArray, 1) To UBound(MyArray, 1)
            .AddNew
            .Fields(1) = MyArray(y, 1)
            .Fields(2) = MyArray(y, 2)
            .Fields(3) = MyArray(y, 3)
            .Fields(4) = MyArray(y, 4)
            .Update
        Next
        .Close
    End With
    Debug.Print vbTab & " records added in " _
            & GetTickCount - lngStart & " milliseconds!"
End Sub

Function GetXLArray(XLFile As String, SheetName As String, XLRange As String) As Variant
    Dim xl As Object, wb As Object
    Set xl = CreateObject("Excel.Application")
    Set wb = xl.Workbooks.Open(XLFile, , -1)
    With wb
        GetXLArray = .Sheets(SheetName).Range(XLRange).Value
        .Saved = True
    End With
    xl.Quit
    'Set xl = Nothing
End Function

Τάσος