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

"Chace" <(E-Mail Removed)> wrote in message
<AF4D8EE3-51A5-492B-88C8-(E-Mail Removed)>:
> 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.

--
Roy-Vidar

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" wrote:

> "Chace" <(E-Mail Removed)> wrote in message
> <AF4D8EE3-51A5-492B-88C8-(E-Mail Removed)>:
> > 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.
>
> --
> Roy-Vidar
>
>
>

"Chace" <(E-Mail Removed)> wrote in message
<2627DD3D-35DC-464D-8DCC-(E-Mail Removed)>:
> 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" wrote:
>
>> "Chace" <(E-Mail Removed)> wrote in message
>> <AF4D8EE3-51A5-492B-88C8-(E-Mail Removed)>:
>>> 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.
>>
>> --
>> Roy-Vidar
>>
>>
>>

Thank you for posting the solution.

--
Roy-Vidar