[jimrenoir]

Γεια σας αντιμετωπίζο το εξής πρόβλημα.
Μέσα από ένα ερώτημα στέλνω τα δεδομένα σε ένα αρχείο εχελ με όνομα 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