ADO Read from Access is very slow...

  • Thread starter Thread starter Deke
  • Start date Start date
D

Deke

I hope someone can help this problem is driving me nuts...

I am trying to do multiple read's against an Access database, based on the
contents of an array, I am using the code from Ron de Bruin's website, and
it's working fine. The only problem I have is it is very very very slow
doing the read's.

I think I saw a post on the forum a couple of weeks ago about something to
do with opening and closing connection to the database, but I can't find it
again.

I hope someone can help, or I think I'm going to go mad.... :(
 
Hi, Tim...

Here's the code I'm using, the first sub is called from a for loop, going
thru array contains record numbers :-

Public Sub Business_Affected_Change_Data_Extract(Change_Number As String,
Headings_Required As Boolean)
EO_Data
GetDataForBusAffect Change_Number, Sheets(Report_Type & "
Changes").Range("A" & Last_Row), _
Headings_Required
End Sub


Public Sub GetDataForBusAffect(MyFieldValue1 As String, DestSheetRange As
Range, FieldNames As Boolean)

If FieldNames Then
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & Data_Folder &
Input_Database & ";"
End If
Set MyDatabase = CreateObject("adodb.recordset")
MySQL = "SELECT " & Change_No & Category & Creation_Date & Implem_Date &
Status & Requestor_Name & Team & Short_Desc & Trim_Field(Service_Variance) &
" FROM " & Input_Table & " WHERE [" & Trim_Field(Change_No) & "] = '" &
MyFieldValue1 & "'"
On Error GoTo ErrorHandler
MyDatabase.Open MySQL, MyConnection, 0, 1, 1
If Not MyDatabase.EOF Then
If FieldNames Then
For col = 0 To MyDatabase.Fields.Count - 1
DestSheetRange.Offset(0, col).Value =
MyDatabase.Fields(col).Name
Next
DestSheetRange.Offset(1, 0).CopyFromRecordset MyDatabase
Else
DestSheetRange.CopyFromRecordset MyDatabase
End If
Data_Exists = True
Else
If Extraction_Count > 1 And Data_Exists = True Then
Data_Exists = True
Else
Data_Exists = False
End If
End If
If Last_Extraction Then
MyDatabase.Close
Set MyDatabase = Nothing
End If
Exit Sub

ErrorHandler:
If Not MyDatabase Is Nothing Then
If MyDatabase.State = adStateOpen Then MyDatabase.Close
End If
Set MyDatabase = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If

As I said it does work, but it is very slow...
 
Looks fine really. How many loops through ? Is the database local or on a
network mapped drive?

As noted, you might consider opening the connection and keeping it open as
you loop through the array.
Also:
1. check the performance of your database query
2. turn off screen updating and set calculation to manual while the
procedure is running

What does EO_Data do ?

Tim

Deke said:
Hi, Tim...

Here's the code I'm using, the first sub is called from a for loop, going
thru array contains record numbers :-

Public Sub Business_Affected_Change_Data_Extract(Change_Number As String,
Headings_Required As Boolean)
EO_Data
GetDataForBusAffect Change_Number, Sheets(Report_Type & "
Changes").Range("A" & Last_Row), _
Headings_Required
End Sub


Public Sub GetDataForBusAffect(MyFieldValue1 As String, DestSheetRange As
Range, FieldNames As Boolean)

If FieldNames Then
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & Data_Folder &
Input_Database & ";"
End If
Set MyDatabase = CreateObject("adodb.recordset")
MySQL = "SELECT " & Change_No & Category & Creation_Date & Implem_Date
&
Status & Requestor_Name & Team & Short_Desc & Trim_Field(Service_Variance)
&
" FROM " & Input_Table & " WHERE [" & Trim_Field(Change_No) & "] = '" &
MyFieldValue1 & "'"
On Error GoTo ErrorHandler
MyDatabase.Open MySQL, MyConnection, 0, 1, 1
If Not MyDatabase.EOF Then
If FieldNames Then
For col = 0 To MyDatabase.Fields.Count - 1
DestSheetRange.Offset(0, col).Value =
MyDatabase.Fields(col).Name
Next
DestSheetRange.Offset(1, 0).CopyFromRecordset MyDatabase
Else
DestSheetRange.CopyFromRecordset MyDatabase
End If
Data_Exists = True
Else
If Extraction_Count > 1 And Data_Exists = True Then
Data_Exists = True
Else
Data_Exists = False
End If
End If
If Last_Extraction Then
MyDatabase.Close
Set MyDatabase = Nothing
End If
Exit Sub

ErrorHandler:
If Not MyDatabase Is Nothing Then
If MyDatabase.State = adStateOpen Then MyDatabase.Close
End If
Set MyDatabase = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If

As I said it does work, but it is very slow...

--
Cheers...


Tim Williams said:
Any code you'd like to share ?

Tim
Click to expand...
Click to expand...
 
Should there be commas in your sql??
"SELECT " & Change_No & ", " & Category & ", " & Creation_Date & ", " &
Implem_Date & ", " & Status & ", " & Requestor_Name & ", " & Team & ", " &
Short_Desc & ", " & Trim_Field(Service_Variance) & " FROM " & Input_Table & "
WHERE [" & Trim_Field(Change_No) & "] = '" & MyFieldValue1 & "'"

Deke said:
Hi, Tim...

Here's the code I'm using, the first sub is called from a for loop, going
thru array contains record numbers :-

Public Sub Business_Affected_Change_Data_Extract(Change_Number As String,
Headings_Required As Boolean)
EO_Data
GetDataForBusAffect Change_Number, Sheets(Report_Type & "
Changes").Range("A" & Last_Row), _
Headings_Required
End Sub


Public Sub GetDataForBusAffect(MyFieldValue1 As String, DestSheetRange As
Range, FieldNames As Boolean)

If FieldNames Then
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & Data_Folder &
Input_Database & ";"
End If
Set MyDatabase = CreateObject("adodb.recordset")
MySQL = "SELECT " & Change_No & Category & Creation_Date & Implem_Date &
Status & Requestor_Name & Team & Short_Desc & Trim_Field(Service_Variance) &
" FROM " & Input_Table & " WHERE [" & Trim_Field(Change_No) & "] = '" &
MyFieldValue1 & "'"
On Error GoTo ErrorHandler
MyDatabase.Open MySQL, MyConnection, 0, 1, 1
If Not MyDatabase.EOF Then
If FieldNames Then
For col = 0 To MyDatabase.Fields.Count - 1
DestSheetRange.Offset(0, col).Value =
MyDatabase.Fields(col).Name
Next
DestSheetRange.Offset(1, 0).CopyFromRecordset MyDatabase
Else
DestSheetRange.CopyFromRecordset MyDatabase
End If
Data_Exists = True
Else
If Extraction_Count > 1 And Data_Exists = True Then
Data_Exists = True
Else
Data_Exists = False
End If
End If
If Last_Extraction Then
MyDatabase.Close
Set MyDatabase = Nothing
End If
Exit Sub

ErrorHandler:
If Not MyDatabase Is Nothing Then
If MyDatabase.State = adStateOpen Then MyDatabase.Close
End If
Set MyDatabase = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If

As I said it does work, but it is very slow...

--
Cheers...


Tim Williams said:
Any code you'd like to share ?

Tim
Click to expand...
Click to expand...
 
Tim,

The test's that I'm running are looping thru about 250 records, but this
could be anything upto 1500 records.

I'm not 100% sure what you mean by check the performance of your database
query, I am just accessing a table in the database, not running a query.

I'll try switching off updating and the calculations.

EO_Data is a sub routine to find the last row of the data in the worksheet
and assigns the row number to LAST_ROW, which is used to put new data below
an current data in the worksheet.

Thank for your reply...

--
Cheers...


Tim Williams said:
Looks fine really. How many loops through ? Is the database local or on a
network mapped drive?

As noted, you might consider opening the connection and keeping it open as
you loop through the array.
Also:
1. check the performance of your database query
2. turn off screen updating and set calculation to manual while the
procedure is running

What does EO_Data do ?

Tim

Deke said:
Hi, Tim...

Here's the code I'm using, the first sub is called from a for loop, going
thru array contains record numbers :-

Public Sub Business_Affected_Change_Data_Extract(Change_Number As String,
Headings_Required As Boolean)
EO_Data
GetDataForBusAffect Change_Number, Sheets(Report_Type & "
Changes").Range("A" & Last_Row), _
Headings_Required
End Sub


Public Sub GetDataForBusAffect(MyFieldValue1 As String, DestSheetRange As
Range, FieldNames As Boolean)

If FieldNames Then
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & Data_Folder &
Input_Database & ";"
End If
Set MyDatabase = CreateObject("adodb.recordset")
MySQL = "SELECT " & Change_No & Category & Creation_Date & Implem_Date
&
Status & Requestor_Name & Team & Short_Desc & Trim_Field(Service_Variance)
&
" FROM " & Input_Table & " WHERE [" & Trim_Field(Change_No) & "] = '" &
MyFieldValue1 & "'"
On Error GoTo ErrorHandler
MyDatabase.Open MySQL, MyConnection, 0, 1, 1
If Not MyDatabase.EOF Then
If FieldNames Then
For col = 0 To MyDatabase.Fields.Count - 1
DestSheetRange.Offset(0, col).Value =
MyDatabase.Fields(col).Name
Next
DestSheetRange.Offset(1, 0).CopyFromRecordset MyDatabase
Else
DestSheetRange.CopyFromRecordset MyDatabase
End If
Data_Exists = True
Else
If Extraction_Count > 1 And Data_Exists = True Then
Data_Exists = True
Else
Data_Exists = False
End If
End If
If Last_Extraction Then
MyDatabase.Close
Set MyDatabase = Nothing
End If
Exit Sub

ErrorHandler:
If Not MyDatabase Is Nothing Then
If MyDatabase.State = adStateOpen Then MyDatabase.Close
End If
Set MyDatabase = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If

As I said it does work, but it is very slow...

--
Cheers...


Tim Williams said:
Any code you'd like to share ?

Tim

I hope someone can help this problem is driving me nuts...

I am trying to do multiple read's against an Access database, based on
the
contents of an array, I am using the code from Ron de Bruin's website,
and
it's working fine. The only problem I have is it is very very very
slow
doing the read's.

I think I saw a post on the forum a couple of weeks ago about something
to
do with opening and closing connection to the database, but I can't
find
it
again.

I hope someone can help, or I think I'm going to go mad.... :(
Click to expand...
Click to expand...
Click to expand...
 
Mike,

There are no comma's in the SQL statment as the field names are all
constants that are defined else where, and they are defined with the coma and
a space in them. The last constant used goes thru a function called
TRIM_FIELD which will change the string length by -2 to take off the comma
and the space.

I did it this way as the field names are used by approx 20 different
extract's and if the names change it is alot easier to change it once, then
have to do it lot's of times.

--
Cheers...


Mike said:
Should there be commas in your sql??
"SELECT " & Change_No & ", " & Category & ", " & Creation_Date & ", " &
Implem_Date & ", " & Status & ", " & Requestor_Name & ", " & Team & ", " &
Short_Desc & ", " & Trim_Field(Service_Variance) & " FROM " & Input_Table & "
WHERE [" & Trim_Field(Change_No) & "] = '" & MyFieldValue1 & "'"

Deke said:
Hi, Tim...

Here's the code I'm using, the first sub is called from a for loop, going
thru array contains record numbers :-

Public Sub Business_Affected_Change_Data_Extract(Change_Number As String,
Headings_Required As Boolean)
EO_Data
GetDataForBusAffect Change_Number, Sheets(Report_Type & "
Changes").Range("A" & Last_Row), _
Headings_Required
End Sub


Public Sub GetDataForBusAffect(MyFieldValue1 As String, DestSheetRange As
Range, FieldNames As Boolean)

If FieldNames Then
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & Data_Folder &
Input_Database & ";"
End If
Set MyDatabase = CreateObject("adodb.recordset")
MySQL = "SELECT " & Change_No & Category & Creation_Date & Implem_Date &
Status & Requestor_Name & Team & Short_Desc & Trim_Field(Service_Variance) &
" FROM " & Input_Table & " WHERE [" & Trim_Field(Change_No) & "] = '" &
MyFieldValue1 & "'"
On Error GoTo ErrorHandler
MyDatabase.Open MySQL, MyConnection, 0, 1, 1
If Not MyDatabase.EOF Then
If FieldNames Then
For col = 0 To MyDatabase.Fields.Count - 1
DestSheetRange.Offset(0, col).Value =
MyDatabase.Fields(col).Name
Next
DestSheetRange.Offset(1, 0).CopyFromRecordset MyDatabase
Else
DestSheetRange.CopyFromRecordset MyDatabase
End If
Data_Exists = True
Else
If Extraction_Count > 1 And Data_Exists = True Then
Data_Exists = True
Else
Data_Exists = False
End If
End If
If Last_Extraction Then
MyDatabase.Close
Set MyDatabase = Nothing
End If
Exit Sub

ErrorHandler:
If Not MyDatabase Is Nothing Then
If MyDatabase.State = adStateOpen Then MyDatabase.Close
End If
Set MyDatabase = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If

As I said it does work, but it is very slow...

--
Cheers...


Tim Williams said:
Any code you'd like to share ?

Tim

I hope someone can help this problem is driving me nuts...

I am trying to do multiple read's against an Access database, based on the
contents of an array, I am using the code from Ron de Bruin's website, and
it's working fine. The only problem I have is it is very very very slow
doing the read's.

I think I saw a post on the forum a couple of weeks ago about something to
do with opening and closing connection to the database, but I can't find
it
again.

I hope someone can help, or I think I'm going to go mad.... :(
Click to expand...
Click to expand...
Click to expand...
 
"select [fieldnames] where [something]" is a SQL query: that's what I meant
by running a query. I was asking if this might be the source of the poor
performance - you could use a timer either side of the line which runs the
SQL to see how long it takes.

Tim

Deke said:
Tim,

The test's that I'm running are looping thru about 250 records, but this
could be anything upto 1500 records.

I'm not 100% sure what you mean by check the performance of your database
query, I am just accessing a table in the database, not running a query.

I'll try switching off updating and the calculations.

EO_Data is a sub routine to find the last row of the data in the worksheet
and assigns the row number to LAST_ROW, which is used to put new data
below
an current data in the worksheet.

Thank for your reply...

--
Cheers...


Tim Williams said:
Looks fine really. How many loops through ? Is the database local or on
a
network mapped drive?

As noted, you might consider opening the connection and keeping it open
as
you loop through the array.
Also:
1. check the performance of your database query
2. turn off screen updating and set calculation to manual while the
procedure is running

What does EO_Data do ?

Tim

Deke said:
Hi, Tim...

Here's the code I'm using, the first sub is called from a for loop,
going
thru array contains record numbers :-

Public Sub Business_Affected_Change_Data_Extract(Change_Number As
String,
Headings_Required As Boolean)
EO_Data
GetDataForBusAffect Change_Number, Sheets(Report_Type & "
Changes").Range("A" & Last_Row), _
Headings_Required
End Sub


Public Sub GetDataForBusAffect(MyFieldValue1 As String, DestSheetRange
As
Range, FieldNames As Boolean)

If FieldNames Then
MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
MyConnection = MyConnection & "Data Source=" & Data_Folder &
Input_Database & ";"
End If
Set MyDatabase = CreateObject("adodb.recordset")
MySQL = "SELECT " & Change_No & Category & Creation_Date &
Implem_Date
&
Status & Requestor_Name & Team & Short_Desc &
Trim_Field(Service_Variance)
&
" FROM " & Input_Table & " WHERE [" & Trim_Field(Change_No) & "] = '" &
MyFieldValue1 & "'"
On Error GoTo ErrorHandler
MyDatabase.Open MySQL, MyConnection, 0, 1, 1
If Not MyDatabase.EOF Then
If FieldNames Then
For col = 0 To MyDatabase.Fields.Count - 1
DestSheetRange.Offset(0, col).Value =
MyDatabase.Fields(col).Name
Next
DestSheetRange.Offset(1, 0).CopyFromRecordset MyDatabase
Else
DestSheetRange.CopyFromRecordset MyDatabase
End If
Data_Exists = True
Else
If Extraction_Count > 1 And Data_Exists = True Then
Data_Exists = True
Else
Data_Exists = False
End If
End If
If Last_Extraction Then
MyDatabase.Close
Set MyDatabase = Nothing
End If
Exit Sub

ErrorHandler:
If Not MyDatabase Is Nothing Then
If MyDatabase.State = adStateOpen Then MyDatabase.Close
End If
Set MyDatabase = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If

As I said it does work, but it is very slow...

--
Cheers...


:

Any code you'd like to share ?

Tim

I hope someone can help this problem is driving me nuts...

I am trying to do multiple read's against an Access database, based
on
the
contents of an array, I am using the code from Ron de Bruin's
website,
and
it's working fine. The only problem I have is it is very very very
slow
doing the read's.

I think I saw a post on the forum a couple of weeks ago about
something
to
do with opening and closing connection to the database, but I can't
find
it
again.

I hope someone can help, or I think I'm going to go mad.... :(
Click to expand...
Click to expand...
Click to expand...
 
You must log in or register to reply here.

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

ADO read of Access... 2
ADO read to and array 4
ADO from Excel to Access 4
Data Entry very slow ... Slow to start WOrksheet_Change 4
"Catastrophic Failure" error using ADO to query Excel Workbook... 3
Zip and mail more than one sheet from the ActiveWorkbook 4
using ADO from Excel 2007 1
Updating a Read Only file 0

Back
Top