ADODB.Connection run-time error -2147467259 (80004005)

G

Guest

I have a weird problem:

I get a connection run-time error if I try to open the third recordset in
the procedure below. Does anyone know what the problem might be?

Private Sub cmd_Update_Click()

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim MySQL As String
Dim dtStart As Date
Dim dtEnd As Date
Dim strMonth As String


Set rs = New ADODB.Recordset
Set cnn = New ADODB.Connection

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=K:\Channelview 2\Adage queries\RawMaterial Adage
TableQuery.mdb"

For i = 5 To 17

If ActiveSheet.Cells(3, i) = 1 Then
dtStart = ActiveSheet.Cells(1, i)
dtEnd = ActiveSheet.Cells(2, i)
strMonth = ActiveSheet.Cells(4, i)

'Calculate fresh production
MySQL = "SELECT Sum([qsel_SMA Production3].[Fresh Production]) " & _
"AS [SumOfFresh Production] " & _
"FROM [qsel_SMA Production3] " & _
"WHERE ((([qsel_SMA Production3].Date1) Between #" & dtStart & "# "
& _
"and #" & dtEnd & "#" & _
"));"

rs.Open MySQL, cnn
Dim dblFreshProduction As Double
dblFreshProduction = Nz(rs![sumofFresh Production], 0)

ActiveSheet.Range(strMonth & "ProductionLBSSMA").Value =
Format(Nz(dblFreshProduction, 0), "##,###,##0")
rs.Close

dtStart = ActiveSheet.Cells(1, i)
dtEnd = ActiveSheet.Cells(2, i)
strMonth = ActiveSheet.Cells(4, i)

'Calculate Inventory
MySQL = "SELECT Sum([SMA qry no SDWuser].LBS) AS SumOfLBS " & _
"FROM [SMA qry no SDWuser];"


rs.Open MySQL, cnn
Dim dblSMAInventory As Double
dblSMAInventory = Nz(rs![sumofLBS], 0)

ActiveSheet.Range(strMonth & "InventorySMA").Value =
Format(Nz(dblSMAInventory, 0), "##,###,##0")
rs.Close

'Calculate % Off Spec
MySQL = "SELECT Sum([SMA qry].LBS) AS SumOfLBS FROM [SMA qry] " & _
"WHERE ((([SMA qry].[Lot Status]) Like 'z*' " & _
"Or ([SMA qry].[Lot Status]) Like 'D-OffSpcRl'));"

'************************************
'The next line is where I get the run-time error -2147467259 (80004005)
'************************************
rs.Open MySQL, cnn
Dim dblSMApercentOffSpec As Double
dblSMApercentOffSpec = (Nz(rs![sumofLBS], 0) + 0.0001) /
dblSMAInventory


ActiveSheet.Range(strMonth & "OSpercentSMA").Value =
Format(Nz(dblSMApercentOffSpec, 0), "##0%")
rs.Close
End If


Next i
Set rs = Nothing
cnn.Close
Set cnn = Nothing

End Sub
 
R

RoyVidar

Chace said:
I have a weird problem:

I get a connection run-time error if I try to open the third
recordset in the procedure below. Does anyone know what the problem
might be?

Private Sub cmd_Update_Click()

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim MySQL As String
Dim dtStart As Date
Dim dtEnd As Date
Dim strMonth As String


Set rs = New ADODB.Recordset
Set cnn = New ADODB.Connection

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=K:\Channelview 2\Adage queries\RawMaterial Adage
TableQuery.mdb"

For i = 5 To 17

If ActiveSheet.Cells(3, i) = 1 Then
dtStart = ActiveSheet.Cells(1, i)
dtEnd = ActiveSheet.Cells(2, i)
strMonth = ActiveSheet.Cells(4, i)

'Calculate fresh production
MySQL = "SELECT Sum([qsel_SMA Production3].[Fresh
Production]) " & _ "AS [SumOfFresh Production] " & _
"FROM [qsel_SMA Production3] " & _
"WHERE ((([qsel_SMA Production3].Date1) Between #" & dtStart
& "# " & _
"and #" & dtEnd & "#" & _
"));"

rs.Open MySQL, cnn
Dim dblFreshProduction As Double
dblFreshProduction = Nz(rs![sumofFresh Production], 0)

ActiveSheet.Range(strMonth & "ProductionLBSSMA").Value =
Format(Nz(dblFreshProduction, 0), "##,###,##0")
rs.Close

dtStart = ActiveSheet.Cells(1, i)
dtEnd = ActiveSheet.Cells(2, i)
strMonth = ActiveSheet.Cells(4, i)

'Calculate Inventory
MySQL = "SELECT Sum([SMA qry no SDWuser].LBS) AS SumOfLBS " &
_ "FROM [SMA qry no SDWuser];"


rs.Open MySQL, cnn
Dim dblSMAInventory As Double
dblSMAInventory = Nz(rs![sumofLBS], 0)

ActiveSheet.Range(strMonth & "InventorySMA").Value =
Format(Nz(dblSMAInventory, 0), "##,###,##0")
rs.Close

'Calculate % Off Spec
MySQL = "SELECT Sum([SMA qry].LBS) AS SumOfLBS FROM [SMA qry]
" & _ "WHERE ((([SMA qry].[Lot Status]) Like 'z*' " & _
"Or ([SMA qry].[Lot Status]) Like 'D-OffSpcRl'));"

'************************************
'The next line is where I get the run-time error -2147467259
(80004005) '************************************
rs.Open MySQL, cnn
Dim dblSMApercentOffSpec As Double
dblSMApercentOffSpec = (Nz(rs![sumofLBS], 0) + 0.0001) /
dblSMAInventory


ActiveSheet.Range(strMonth & "OSpercentSMA").Value =
Format(Nz(dblSMApercentOffSpec, 0), "##0%")
rs.Close
End If


Next i
Set rs = Nothing
cnn.Close
Set cnn = Nothing

End Sub

I don't know, but once I was experiencing something similar, always on
the same line, where using separate recordset objects helped. I think,
that this only occured on the 2000 version, with me, but if it is
version related, it might very well be related to MDAC too.

Unless someone pops in with the real solution, it would probably not
hurt to try this on a copy (using three separate recordset objects),
and see if it made any difference.

Another hint, would be to try to do more with the queries, if possible,
so that you don't need to reopen recordsets all the time.
 
G

Guest

Thanks for your help Roy-Vidar. I tried giving unique names to the three
recordsets but the connection error still occurred.

However, through more troubleshooting, I found the problem and fixed it.
The Access database that I connect to contains many linked tables to my
company's ERP system (another database). A long time ago, when I created
these links, I found that I was not conistent in selecting the "Save
Password" check box during the link process. Evidentally, if one of the
queries that I wanted to open in Excel VBA was connected to one of these
tables then the connection failed. I went back to my Access database and
re-linked all of my tables, this time making sure to check the "Save
Password" check box and the problem in Excel has been fixed. Furthermore, I
was able to keep one name for all of the recordset objects without any
problem. I am using Access 2003.

Thanks for your help. I hope my resolution can help someone else!

Chace

RoyVidar said:
Chace said:
I have a weird problem:

I get a connection run-time error if I try to open the third
recordset in the procedure below. Does anyone know what the problem
might be?

Private Sub cmd_Update_Click()

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim MySQL As String
Dim dtStart As Date
Dim dtEnd As Date
Dim strMonth As String


Set rs = New ADODB.Recordset
Set cnn = New ADODB.Connection

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=K:\Channelview 2\Adage queries\RawMaterial Adage
TableQuery.mdb"

For i = 5 To 17

If ActiveSheet.Cells(3, i) = 1 Then
dtStart = ActiveSheet.Cells(1, i)
dtEnd = ActiveSheet.Cells(2, i)
strMonth = ActiveSheet.Cells(4, i)

'Calculate fresh production
MySQL = "SELECT Sum([qsel_SMA Production3].[Fresh
Production]) " & _ "AS [SumOfFresh Production] " & _
"FROM [qsel_SMA Production3] " & _
"WHERE ((([qsel_SMA Production3].Date1) Between #" & dtStart
& "# " & _
"and #" & dtEnd & "#" & _
"));"

rs.Open MySQL, cnn
Dim dblFreshProduction As Double
dblFreshProduction = Nz(rs![sumofFresh Production], 0)

ActiveSheet.Range(strMonth & "ProductionLBSSMA").Value =
Format(Nz(dblFreshProduction, 0), "##,###,##0")
rs.Close

dtStart = ActiveSheet.Cells(1, i)
dtEnd = ActiveSheet.Cells(2, i)
strMonth = ActiveSheet.Cells(4, i)

'Calculate Inventory
MySQL = "SELECT Sum([SMA qry no SDWuser].LBS) AS SumOfLBS " &
_ "FROM [SMA qry no SDWuser];"


rs.Open MySQL, cnn
Dim dblSMAInventory As Double
dblSMAInventory = Nz(rs![sumofLBS], 0)

ActiveSheet.Range(strMonth & "InventorySMA").Value =
Format(Nz(dblSMAInventory, 0), "##,###,##0")
rs.Close

'Calculate % Off Spec
MySQL = "SELECT Sum([SMA qry].LBS) AS SumOfLBS FROM [SMA qry]
" & _ "WHERE ((([SMA qry].[Lot Status]) Like 'z*' " & _
"Or ([SMA qry].[Lot Status]) Like 'D-OffSpcRl'));"

'************************************
'The next line is where I get the run-time error -2147467259
(80004005) '************************************
rs.Open MySQL, cnn
Dim dblSMApercentOffSpec As Double
dblSMApercentOffSpec = (Nz(rs![sumofLBS], 0) + 0.0001) /
dblSMAInventory


ActiveSheet.Range(strMonth & "OSpercentSMA").Value =
Format(Nz(dblSMApercentOffSpec, 0), "##0%")
rs.Close
End If


Next i
Set rs = Nothing
cnn.Close
Set cnn = Nothing

End Sub

I don't know, but once I was experiencing something similar, always on
the same line, where using separate recordset objects helped. I think,
that this only occured on the 2000 version, with me, but if it is
version related, it might very well be related to MDAC too.

Unless someone pops in with the real solution, it would probably not
hurt to try this on a copy (using three separate recordset objects),
and see if it made any difference.

Another hint, would be to try to do more with the queries, if possible,
so that you don't need to reopen recordsets all the time.
 
R

RoyVidar

Chace said:
Thanks for your help Roy-Vidar. I tried giving unique names to the
three recordsets but the connection error still occurred.

However, through more troubleshooting, I found the problem and fixed
it. The Access database that I connect to contains many linked tables
to my company's ERP system (another database). A long time ago,
when I created these links, I found that I was not conistent in
selecting the "Save Password" check box during the link process.
Evidentally, if one of the queries that I wanted to open in Excel
VBA was connected to one of these tables then the connection failed.
I went back to my Access database and re-linked all of my tables,
this time making sure to check the "Save Password" check box and the
problem in Excel has been fixed. Furthermore, I was able to keep
one name for all of the recordset objects without any problem. I am
using Access 2003.

Thanks for your help. I hope my resolution can help someone else!

Chace

RoyVidar said:
Chace said:
I have a weird problem:

I get a connection run-time error if I try to open the third
recordset in the procedure below. Does anyone know what the
problem might be?

Private Sub cmd_Update_Click()

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim MySQL As String
Dim dtStart As Date
Dim dtEnd As Date
Dim strMonth As String


Set rs = New ADODB.Recordset
Set cnn = New ADODB.Connection

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=K:\Channelview 2\Adage queries\RawMaterial
Adage TableQuery.mdb"

For i = 5 To 17

If ActiveSheet.Cells(3, i) = 1 Then
dtStart = ActiveSheet.Cells(1, i)
dtEnd = ActiveSheet.Cells(2, i)
strMonth = ActiveSheet.Cells(4, i)

'Calculate fresh production
MySQL = "SELECT Sum([qsel_SMA Production3].[Fresh
Production]) " & _ "AS [SumOfFresh Production] " & _
"FROM [qsel_SMA Production3] " & _
"WHERE ((([qsel_SMA Production3].Date1) Between #" &
dtStart & "# " & _
"and #" & dtEnd & "#" & _
"));"

rs.Open MySQL, cnn
Dim dblFreshProduction As Double
dblFreshProduction = Nz(rs![sumofFresh Production], 0)

ActiveSheet.Range(strMonth & "ProductionLBSSMA").Value =
Format(Nz(dblFreshProduction, 0), "##,###,##0")
rs.Close

dtStart = ActiveSheet.Cells(1, i)
dtEnd = ActiveSheet.Cells(2, i)
strMonth = ActiveSheet.Cells(4, i)

'Calculate Inventory
MySQL = "SELECT Sum([SMA qry no SDWuser].LBS) AS SumOfLBS "
& _ "FROM [SMA qry no SDWuser];"


rs.Open MySQL, cnn
Dim dblSMAInventory As Double
dblSMAInventory = Nz(rs![sumofLBS], 0)

ActiveSheet.Range(strMonth & "InventorySMA").Value =
Format(Nz(dblSMAInventory, 0), "##,###,##0")
rs.Close

'Calculate % Off Spec
MySQL = "SELECT Sum([SMA qry].LBS) AS SumOfLBS FROM [SMA
qry] " & _ "WHERE ((([SMA qry].[Lot Status]) Like 'z*' " &
_ "Or ([SMA qry].[Lot Status]) Like 'D-OffSpcRl'));"

'************************************
'The next line is where I get the run-time error -2147467259
(80004005) '************************************
rs.Open MySQL, cnn
Dim dblSMApercentOffSpec As Double
dblSMApercentOffSpec = (Nz(rs![sumofLBS], 0) + 0.0001) /
dblSMAInventory


ActiveSheet.Range(strMonth & "OSpercentSMA").Value =
Format(Nz(dblSMApercentOffSpec, 0), "##0%")
rs.Close
End If


Next i
Set rs = Nothing
cnn.Close
Set cnn = Nothing

End Sub

I don't know, but once I was experiencing something similar, always
on the same line, where using separate recordset objects helped. I
think, that this only occured on the 2000 version, with me, but if
it is version related, it might very well be related to MDAC too.

Unless someone pops in with the real solution, it would probably not
hurt to try this on a copy (using three separate recordset objects),
and see if it made any difference.

Another hint, would be to try to do more with the queries, if
possible, so that you don't need to reopen recordsets all the time.

Thank you for posting the solution.
 

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

Top