I use this code to import fdata from mdb to excel sheet , but is very
very slow, is possible to speed,the copy in sheet, other way are
welcome, tks.
Note: absolutly record by rekord in celle by cell and not in "one
shot", because i make other opertaion in cell range during the
import...
Tks

Global Const gPROVADatabasePath =
"\\GCD01F4500\DATI\PUBBLICA\Pianificazione\Nuo va
Cartella\REPORT\REPORT.MDB"

Sub IMPORTA_H7469()

Dim NOMEDB As String
Dim CONT As String
Dim I As Long
Dim FOUND_ID
Dim CONTA1 As String
Dim CONTA_RISP As String

Application.ScreenUpdating = False

Set ELENCO = Worksheets("H7469")
NOMEDB = gPROVADatabasePath
Dim OggettoConnessione As ADODB.Connection
Dim OggettoRecordset As ADODB.Recordset
Dim StringaDiConnessione As String
StringaDiConnessione = "DRIVER={Microsoft Access Driver
(*.mdb)};DBQ=" & NOMEDB
Set OggettoConnessione = New ADODB.Connection
OggettoConnessione.Open StringaDiConnessione
Set OggettoRecordset = New ADODB.Recordset
OggettoRecordset.Open "SELECT * from BANCA_ASS_H7469",
OggettoConnessione, adOpenKeyset, adLockOptimistic

CONT = Sheets("H7469").Cells(65536, 1).End(xlUp).Row + 1

CONTA_RISP = 0
CONTA1 = 0
I = 0

Do While Not OggettoRecordset.EOF


ID = OggettoRecordset("PROVA18")
Set FOUND_ID = Sheets("H7469").Columns("R:R").Find(ID,
LookAt:=xlWhole)
If Not FOUND_ID Is Nothing Then

Else

ELENCO.Range("A" & CONT).Value = OggettoRecordset("FIL")
ELENCO.Range("B" & CONT).Value = OggettoRecordset("TIP")
ELENCO.Range("C" & CONT).Value = OggettoRecordset("SOC")
ELENCO.Range("D" & CONT).Value = OggettoRecordset("PROD")
ELENCO.Range("E" & CONT).Value =
OggettoRecordset("SOTTOSCRITTORE")
ELENCO.Range("F" & CONT).Value = OggettoRecordset("COPE")
ELENCO.Range("G" & CONT).Value =
OggettoRecordset("NPROPOSTA")
ELENCO.Range("H" & CONT).Value = OggettoRecordset("DA")
ELENCO.Range("I" & CONT).Value =
OggettoRecordset("IMPORTO")
ELENCO.Range("J" & CONT).Value = OggettoRecordset("RET")
ELENCO.Range("K" & CONT).Value = OggettoRecordset("DP")
ELENCO.Range("L" & CONT).Value = OggettoRecordset("STATO")
ELENCO.Range("M" & CONT).Value = OggettoRecordset("TIPO")
ELENCO.Range("N" & CONT).Value = OggettoRecordset("DAL")
ELENCO.Range("O" & CONT).Value = OggettoRecordset("AL")
ELENCO.Range("P" & CONT).Value = OggettoRecordset("TIP1")
ELENCO.Range("Q" & CONT).Value = OggettoRecordset("PROD1")

ELENCO.Range("R" & CONT).Value =
OggettoRecordset("PROVA18")

CONTA1 = CONTA1 + 1
CONT = CONT + 1

End If

CONTA_RISP = CONTA_RISP + 1

DoEvents

CARICA_DATI_.TextBox152.Value = CONTA_RISP
CARICA_DATI_.TextBox155.Value = CONTA1

OggettoRecordset.MoveNext

I = I + 1

CARICA_DATI_.ProgressBar1.Value = (I /
OggettoRecordset.RecordCount) * 100

Loop

OggettoRecordset.Close
OggettoRecordset.Open "SELECT Count(FIL) As Cnt FROM
BANCA_ASS_H7469", StringaDiConnessione, adOpenKeyset, adLockOptimistic,
adCmdText
Sheets("H7469").Range("D1") = OggettoRecordset!cnt

OggettoRecordset.Close
Set OggettoRecordset = Nothing
OggettoConnessione.Close
Set OggettoConnessione = Nothing

ActiveWorkbook.Save

Unload CARICA_DATI_

Application.ScreenUpdating = True


End Sub

Now my code is a "lighting" (Fulmine) in italian
Pizza for you from Napoli.
Sal.

Alok ha scritto:

Try switching off the calculation and switching it back to Automatic at the end

Application.calculation = xlCalculationManual
.....
....
Application.calculation = xlCalculationAutomatic

Alok

"sal21" wrote:

I use this code to import fdata from mdb to excel sheet , but is very
very slow, is possible to speed,the copy in sheet, other way are
welcome, tks.
Note: absolutly record by rekord in celle by cell and not in "one
shot", because i make other opertaion in cell range during the
import...
Tks

Global Const gPROVADatabasePath =
"\\GCD01F4500\DATI\PUBBLICA\Pianificazione\Nuo va
Cartella\REPORT\REPORT.MDB"

Sub IMPORTA_H7469()

Dim NOMEDB As String
Dim CONT As String
Dim I As Long
Dim FOUND_ID
Dim CONTA1 As String
Dim CONTA_RISP As String

Application.ScreenUpdating = False

Set ELENCO = Worksheets("H7469")
NOMEDB = gPROVADatabasePath
Dim OggettoConnessione As ADODB.Connection
Dim OggettoRecordset As ADODB.Recordset
Dim StringaDiConnessione As String
StringaDiConnessione = "DRIVER={Microsoft Access Driver
(*.mdb)};DBQ=" & NOMEDB
Set OggettoConnessione = New ADODB.Connection
OggettoConnessione.Open StringaDiConnessione
Set OggettoRecordset = New ADODB.Recordset
OggettoRecordset.Open "SELECT * from BANCA_ASS_H7469",
OggettoConnessione, adOpenKeyset, adLockOptimistic

CONT = Sheets("H7469").Cells(65536, 1).End(xlUp).Row + 1

CONTA_RISP = 0
CONTA1 = 0
I = 0

Do While Not OggettoRecordset.EOF


ID = OggettoRecordset("PROVA18")
Set FOUND_ID = Sheets("H7469").Columns("R:R").Find(ID,
LookAt:=xlWhole)
If Not FOUND_ID Is Nothing Then

Else

ELENCO.Range("A" & CONT).Value = OggettoRecordset("FIL")
ELENCO.Range("B" & CONT).Value = OggettoRecordset("TIP")
ELENCO.Range("C" & CONT).Value = OggettoRecordset("SOC")
ELENCO.Range("D" & CONT).Value = OggettoRecordset("PROD")
ELENCO.Range("E" & CONT).Value =
OggettoRecordset("SOTTOSCRITTORE")
ELENCO.Range("F" & CONT).Value = OggettoRecordset("COPE")
ELENCO.Range("G" & CONT).Value =
OggettoRecordset("NPROPOSTA")
ELENCO.Range("H" & CONT).Value = OggettoRecordset("DA")
ELENCO.Range("I" & CONT).Value =
OggettoRecordset("IMPORTO")
ELENCO.Range("J" & CONT).Value = OggettoRecordset("RET")
ELENCO.Range("K" & CONT).Value = OggettoRecordset("DP")
ELENCO.Range("L" & CONT).Value = OggettoRecordset("STATO")
ELENCO.Range("M" & CONT).Value = OggettoRecordset("TIPO")
ELENCO.Range("N" & CONT).Value = OggettoRecordset("DAL")
ELENCO.Range("O" & CONT).Value = OggettoRecordset("AL")
ELENCO.Range("P" & CONT).Value = OggettoRecordset("TIP1")
ELENCO.Range("Q" & CONT).Value = OggettoRecordset("PROD1")

ELENCO.Range("R" & CONT).Value =
OggettoRecordset("PROVA18")

CONTA1 = CONTA1 + 1
CONT = CONT + 1

End If

CONTA_RISP = CONTA_RISP + 1

DoEvents

CARICA_DATI_.TextBox152.Value = CONTA_RISP
CARICA_DATI_.TextBox155.Value = CONTA1

OggettoRecordset.MoveNext

I = I + 1

CARICA_DATI_.ProgressBar1.Value = (I /
OggettoRecordset.RecordCount) * 100

Loop

OggettoRecordset.Close
OggettoRecordset.Open "SELECT Count(FIL) As Cnt FROM
BANCA_ASS_H7469", StringaDiConnessione, adOpenKeyset, adLockOptimistic,
adCmdText
Sheets("H7469").Range("D1") = OggettoRecordset!cnt

OggettoRecordset.Close
Set OggettoRecordset = Nothing
OggettoConnessione.Close
Set OggettoConnessione = Nothing

ActiveWorkbook.Save

Unload CARICA_DATI_

Application.ScreenUpdating = True


End Sub