Forum

Forum (https://www.ms-office.gr/forum/)
-   Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)
-   -   Πρόβλημα σε κώδικα (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/1117-problima-se-kodika.html)

jimrenoir 07-05-11 15:13

Πρόβλημα σε κώδικα
 
1 Συνημμένο(α)
Γεια σας αντιμετωπίζο το εξής πρόβλημα.
Μέσα από ένα ερώτημα στέλνω τα δεδομένα σε ένα αρχείο εχελ με όνομα RUD και στην συνέχεια αφού γίνει κάποια αυτόματη επεξεργασία σε ένα άλλο φύλλο του εχελ (RUD) τα ξαναφέρνω στην acces 2007 σε ένα πίνακα με όνομα RUD.
Οταν στο αρχειο excel σβήσω τα δεδομένα απο το φυλλο 1 τοτε ο κώδικας δουλεύει κανονικα
Οταν όμως ξανατρέξω τον κώδικα μού χτυπάει ότ δεν ειναι δυνατή η επέκταση της περιοχής.
Το παράδοξο είναι πως στο αρχείο excel μετα την εκτέλεση απο το Α1 έως Α63400 περιπου μου σβήνει τα δεδομένα ενώ απο κεί και κάτω οχι.
Το excel δεν το ανοίγω καθόλου χειροκίνητα.Σας ανεβάζω τον κώδικα γιατι το αρχείο excel και το αρχείο της acces που ανεβάζω μαζι είνα σε μορφή rar.
Πρέπει να αποσυμπιεστη στο φάκελο MIDAS STO C:\
Option Compare Database
Option Explicit

Function CalculateInXL()
Dim XLFileName As String, xl As Object, wb As Object
On Error GoTo ExportErr
XLFileName = "C:\MIDAS\RUD.xlsX"
DoCmd.TransferSpreadsheet _
TransferType:=acExport, _
SpreadSheetType:=acSpreadsheetTypeExcel8, _
TableName:="HELP", _
FileName:=XLFileName, _
HasFieldNames:=True
ExportErr:
If Err Then
MsgBox Err.Description
Exit Function
End If
On Error GoTo XLErr
Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Open(XLFileName)
If xl.Calculation <> -4105 Then xl.Calculatefull
wb.Save
wb.Close False
xl.Quit
Set xl = Nothing
XLErr:
If Err Then
On Error Resume Next
If Not xl Is Nothing Then xl.Visible = True
If Not wb Is Nothing Then Set wb = Nothing
If Not xl Is Nothing Then Set xl = Nothing
MsgBox Err.Description
Exit Function
End If
On Error GoTo ImportErr
DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadSheetType:=acSpreadsheetTypeExcel8, _
TableName:="RUD", _
FileName:=XLFileName, _
HasFieldNames:=True, _
Range:="RUD!A1:R160000"
DoCmd.RunSQL "DELETE * FROM RUD WHERE RUD.[ROUND] Is Null OR RUD.[ROUND]=0;"
DoCmd.SetWarnings True
MsgBox "Finished!!", vbInformation, "Transfer to EXCEL"
ImportErr:
If Err Then MsgBox Err.Description
End Function

Tasos 08-05-11 01:37

1 Συνημμένο(α)
Αγαπητέ Δημήτρη,
για να αποφύγουμε περιορισμούς και άλλα προβλήματα που εμφανίζονται σε διαδικασίες
μεταφοράς δεδομένων ανάμεσα σε Excel και Access αλλά και να βελτιώσουμε την ταχύτητα μεταφοράς τους, είναι προτιμότερο να συνδέσουμε
τον πίνακα tblHelp (τον δημιουργούμε αυτόματα με εκτέλεση SQL και περιέχει τα δεδομένα
του ερωτήματος HELP) σε φύλλο αρχείου *.xlsb της Excel.

Κατόπιν ανοίγουμε προγραμματιστικά την Excel για να ανανεώσει τα εξωτερικά δεδομένα και
να τα υπολογίσει.

Στο επόμενο βήμα εισάγουμε το φύλλο της Excel στη βάση με χρήση της εντολής DoCmd.RunSavedImportExport "Import-RUD"
όπου "Import-RUD" είναι το όνομα της αποθηκευμένης εισαγωγής που περιέχει ότι χρειάζεται
για να εισαχθεί το φύλλο RUD με επιτυχία.

Αποσυμπίεσε τα 2 παραδειγματικά αρχεία του συνημμένου στο C:\MIDAS και κάνε τις δοκιμές σου.

Καλή συνέχεια!

Τάσος

jimrenoir 10-05-11 14:50

Ευχαριστώ
 
Όπως πάντα σε ότι έχω ρωτήσει απόλυτα σωστός ευχαριστώ.


Η ώρα είναι 15:58.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2