Data source object already initialized

S

sperlmutter

New Member
Joined
Jul 2, 2012
Messages
2
I am receiving this error message: "Data source object already initialized". It is popping up for the bold portion below.

Set xlws2 = xlWb.Worksheets("Productive Hours")
Set cnn = Application.CurrentProject.connection
Set rstDistro = GetRecordset(cnn, "SELECT * FROM ROM_regions", NoUpdates)

I also have copied the enter coding as well. The code will run on one computer but not another. The references selected are the exact same. I have no idea why I keep getting the error on one machine while it runs without issue on another that is identical in programs. Any help would be appreciated. Thanks.

-Scott






Option Compare Database
Option Explicit
'Dim rst As ADODB.Recordset
'Dim cnn As ADODB.connection
'Dim sql As String
Function Temp_RUN()
Dim dar As String
Dim dar1 As String
Dim dar2 As String
Dim cnn As ADODB.connection
Dim rstDistro As ADODB.Recordset
Dim rst As ADODB.Recordset
Dim rst1 As ADODB.Recordset
Dim rst2 As ADODB.Recordset
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
'Dim xlws As Excel.Worksheet
Dim xlws As Excel.Worksheet
Dim xlws1 As Excel.Worksheet
Dim xlws2 As Excel.Worksheet
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open("\\RIVERFRONT1\DNSC\National_Team\Perlmutter\OTL PPH Database\Facility PPH OTL.xls ") 'This is the template link
Set xlws = xlWb.Worksheets("Internal Points")
Set xlws1 = xlWb.Worksheets("Total Hours")
Set xlws2 = xlWb.Worksheets("Productive Hours")
Set cnn = Application.CurrentProject.connection
Set rstDistro = GetRecordset(cnn, "SELECT * FROM ROM_regions", NoUpdates)
rstDistro.Open , , adOpenForwardOnly, adLockReadOnly
rstDistro.MoveFirst

' xlApp.Visible = True 'Shows the excel sheet
DoCmd.SetWarnings False
Do While rstDistro.EOF = False

'Run query as SQL and paste data into the sheet ***************************************
'Internal Points
dar = "TRANSFORM Sum(IIf(IsNull([points]),0,[points])) AS [Internal Points] " & _
"SELECT [Order of ROMs].Number, [Order of ROMs].Facility_Name " & _
"FROM tbl_PPH_base_data INNER JOIN [Order of ROMs] ON tbl_PPH_base_data.facility_credited = [Order of ROMs].Number " & _
"WHERE (((([Order of ROMs].ROM)='" & rstDistro.Fields!ROM & "')) And ((tbl_PPH_base_data.work_date) >= #12/24/2011#)) " & _
"GROUP BY [Order of ROMs].Number, [Order of ROMs].Facility_Name, [Order of ROMs].Order, [Order of ROMs].ROM " & _
"ORDER BY [Order of ROMs].Order " & _
"PIVOT tbl_PPH_base_data.work_date;"


Set cnn = Application.CurrentProject.connection
Set rst = GetRecordset(cnn, dar, NoUpdates)
rst.Open , , adOpenForwardOnly, adLockReadOnly

'Total Hours
dar1 = "TRANSFORM Sum(IIf(IsNull([total_hours]),0,[total_hours])) AS [Total Hours] " & _
"SELECT [Order of ROMs].Number, [Order of ROMs].Facility_Name " & _
"FROM tbl_PPH_base_data INNER JOIN [Order of ROMs] ON tbl_PPH_base_data.facility_credited = [Order of ROMs].Number " & _
"WHERE (((([Order of ROMs].ROM)='" & rstDistro.Fields!ROM & "')) And ((tbl_PPH_base_data.work_date) >= #12/24/2011#)) " & _
"GROUP BY [Order of ROMs].Number, [Order of ROMs].Facility_Name, [Order of ROMs].Order, [Order of ROMs].ROM " & _
"ORDER BY [Order of ROMs].Order " & _
"PIVOT tbl_PPH_base_data.work_date;"


Set cnn = Application.CurrentProject.connection
Set rst1 = GetRecordset(cnn, dar1, NoUpdates)
rst1.Open , , adOpenForwardOnly, adLockReadOnly

'Productive Hours
dar2 = "TRANSFORM Sum(IIf(IsNull([working_hours]),0,[working_hours])) AS [Productive Hours] " & _
"SELECT [Order of ROMs].Number, [Order of ROMs].Facility_Name " & _
"FROM tbl_PPH_base_data INNER JOIN [Order of ROMs] ON tbl_PPH_base_data.facility_credited = [Order of ROMs].Number " & _
"WHERE (((([Order of ROMs].ROM)='" & rstDistro.Fields!ROM & "')) And ((tbl_PPH_base_data.work_date) >= #12/24/2011#)) " & _
"GROUP BY [Order of ROMs].Number, [Order of ROMs].Facility_Name, [Order of ROMs].Order, [Order of ROMs].ROM " & _
"ORDER BY [Order of ROMs].Order " & _
"PIVOT tbl_PPH_base_data.work_date;"

Set cnn = Application.CurrentProject.connection
Set rst2 = GetRecordset(cnn, dar2, NoUpdates)
rst2.Open , , adOpenForwardOnly, adLockReadOnly


Dim r As Integer
r = rstDistro.Fields!Row

xlws.Cells(r, 3).CopyFromRecordset rst
xlws1.Cells(r, 3).CopyFromRecordset rst1
xlws2.Cells(r, 3).CopyFromRecordset rst2
' xlws.Cells(r, 83).CopyFromRecordset rst 'This is for the real excel sheet where 1/1/12 is in column CE
rstDistro.MoveNext

Loop

' xlws.Range("A1").Select
xlWb.SaveAs "\\RIVERFRONT1\DNSC\National_Team\Perlmutter\OTL PPH Database\Facility PPH OTL Test.xls"

xlApp.Quit
Set xlws = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
rstDistro.Close
Set rstDistro = Nothing
Set rst = Nothing


End Function
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
sperlmutter said:
I am receiving this error message: "Data source object already initialized". It is popping up for the bold portion below.

Set xlws2 = xlWb.Worksheets("Productive Hours")
Set cnn = Application.CurrentProject.connection
Set rstDistro = GetRecordset(cnn, "SELECT * FROM ROM_regions", NoUpdates)

I also have copied the enter coding as well. The code will run on one computer but not another. The references selected are the exact same. I have no idea why I keep getting the error on one machine while it runs without issue on another that is identical in programs. Any help would be appreciated. Thanks.

-Scott






Option Compare Database
Option Explicit
'Dim rst As ADODB.Recordset
'Dim cnn As ADODB.connection
'Dim sql As String
Function Temp_RUN()
Dim dar As String
Dim dar1 As String
Dim dar2 As String
Dim cnn As ADODB.connection
Dim rstDistro As ADODB.Recordset
Dim rst As ADODB.Recordset
Dim rst1 As ADODB.Recordset
Dim rst2 As ADODB.Recordset
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
'Dim xlws As Excel.Worksheet
Dim xlws As Excel.Worksheet
Dim xlws1 As Excel.Worksheet
Dim xlws2 As Excel.Worksheet
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open("\\RIVERFRONT1\DNSC\National_Team\Perlmutter\OTL PPH Database\Facility PPH OTL.xls ") 'This is the template link
Set xlws = xlWb.Worksheets("Internal Points")
Set xlws1 = xlWb.Worksheets("Total Hours")
Set xlws2 = xlWb.Worksheets("Productive Hours")
Set cnn = Application.CurrentProject.connection
Set rstDistro = GetRecordset(cnn, "SELECT * FROM ROM_regions", NoUpdates)
rstDistro.Open , , adOpenForwardOnly, adLockReadOnly
rstDistro.MoveFirst

' xlApp.Visible = True 'Shows the excel sheet
DoCmd.SetWarnings False
Do While rstDistro.EOF = False

'Run query as SQL and paste data into the sheet ***************************************
'Internal Points
dar = "TRANSFORM Sum(IIf(IsNull([points]),0,[points])) AS [Internal Points] " & _
"SELECT [Order of ROMs].Number, [Order of ROMs].Facility_Name " & _
"FROM tbl_PPH_base_data INNER JOIN [Order of ROMs] ON tbl_PPH_base_data.facility_credited = [Order of ROMs].Number " & _
"WHERE (((([Order of ROMs].ROM)='" & rstDistro.Fields!ROM & "')) And ((tbl_PPH_base_data.work_date) >= #12/24/2011#)) " & _
"GROUP BY [Order of ROMs].Number, [Order of ROMs].Facility_Name, [Order of ROMs].Order, [Order of ROMs].ROM " & _
"ORDER BY [Order of ROMs].Order " & _
"PIVOT tbl_PPH_base_data.work_date;"


Set cnn = Application.CurrentProject.connection
Set rst = GetRecordset(cnn, dar, NoUpdates)
rst.Open , , adOpenForwardOnly, adLockReadOnly

'Total Hours
dar1 = "TRANSFORM Sum(IIf(IsNull([total_hours]),0,[total_hours])) AS [Total Hours] " & _
"SELECT [Order of ROMs].Number, [Order of ROMs].Facility_Name " & _
"FROM tbl_PPH_base_data INNER JOIN [Order of ROMs] ON tbl_PPH_base_data.facility_credited = [Order of ROMs].Number " & _
"WHERE (((([Order of ROMs].ROM)='" & rstDistro.Fields!ROM & "')) And ((tbl_PPH_base_data.work_date) >= #12/24/2011#)) " & _
"GROUP BY [Order of ROMs].Number, [Order of ROMs].Facility_Name, [Order of ROMs].Order, [Order of ROMs].ROM " & _
"ORDER BY [Order of ROMs].Order " & _
"PIVOT tbl_PPH_base_data.work_date;"


Set cnn = Application.CurrentProject.connection
Set rst1 = GetRecordset(cnn, dar1, NoUpdates)
rst1.Open , , adOpenForwardOnly, adLockReadOnly

'Productive Hours
dar2 = "TRANSFORM Sum(IIf(IsNull([working_hours]),0,[working_hours])) AS [Productive Hours] " & _
"SELECT [Order of ROMs].Number, [Order of ROMs].Facility_Name " & _
"FROM tbl_PPH_base_data INNER JOIN [Order of ROMs] ON tbl_PPH_base_data.facility_credited = [Order of ROMs].Number " & _
"WHERE (((([Order of ROMs].ROM)='" & rstDistro.Fields!ROM & "')) And ((tbl_PPH_base_data.work_date) >= #12/24/2011#)) " & _
"GROUP BY [Order of ROMs].Number, [Order of ROMs].Facility_Name, [Order of ROMs].Order, [Order of ROMs].ROM " & _
"ORDER BY [Order of ROMs].Order " & _
"PIVOT tbl_PPH_base_data.work_date;"

Set cnn = Application.CurrentProject.connection
Set rst2 = GetRecordset(cnn, dar2, NoUpdates)
rst2.Open , , adOpenForwardOnly, adLockReadOnly


Dim r As Integer
r = rstDistro.Fields!Row

xlws.Cells(r, 3).CopyFromRecordset rst
xlws1.Cells(r, 3).CopyFromRecordset rst1
xlws2.Cells(r, 3).CopyFromRecordset rst2
' xlws.Cells(r, 83).CopyFromRecordset rst 'This is for the real excel sheet where 1/1/12 is in column CE
rstDistro.MoveNext

Loop

' xlws.Range("A1").Select
xlWb.SaveAs "\\RIVERFRONT1\DNSC\National_Team\Perlmutter\OTL PPH Database\Facility PPH OTL Test.xls"

xlApp.Quit
Set xlws = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
rstDistro.Close
Set rstDistro = Nothing
Set rst = Nothing


End Function
Click to expand...

See the red marked text
 
Upvote 0
It isn't the coding. It is something in the settings as the code works on another computer. If I take out the set cnn from running later in the code or even at all, I get other errors such as, "Object variable or With block variable not set" on the following line "rstDistro.Open , , adOpenForwardOnly, adLockReadOnly". This is on the initial set cnn as it won't get far in the code. Does anyone have an idea for what settings I need to have in order to not have any errors so the code can run on this computer like it does the other?
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,224,586
Messages
6,179,719
Members
452,939
Latest member
WCrawford

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top