VBA to connect to Access MDB database in Shared mode

[mrfitness]

I currently have Excel VBA code that connects to an Access database to run a query and returns the results back into Excel. This Excel application is used by many users across the country and is linked to the same Access database on a public drive. The database has sensitive data so it is password protected to prevent users from opening the MDB file outside the application.

However I finding that sometimes users get the following error:
Error Number: -2147467259
Error Description: Could not use ''; file already in use.

I believe that I close the connection after I am done with the query (see code below) so I don't think that is the issue.

After doing some research, it was said that the cause of the error would be if a user has their default open mode in Access to 'Exclusive'. There were suggestions to force Access to be open in Shared mode (instead of Exclusive).

How can I achieve this? It is not a Parameter of the ADO Open Method.

'Set destination
    Set Location = [AG2]
     
     'Set source
    MyConn = "C:\PAT2.mdb"
     
     'Create query
    sSQL = "SELECT sg_lookup.salesgroup, sg_lookup.field_nat, sg_lookup.group_dl, sg_lookup.coord_dl, sg_lookup.rsm_dl, sg_lookup.office, sg_lookup.disctrict, sg_lookup.gm, sg_lookup.sd, sg_lookup.vp, sg_lookup.admin, sg_lookup.min_rev FROM sg_lookup WHERE (((sg_lookup.cell_link)=" & Range("sales_dd_link").Value & "));"
    
    strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=P:\Pricing\Databases\PAT.mdw;Persist Security Info=False;Jet OLEDB:System database=P:\Pricing\Databases\System2.mdw  Password=pw;User ID=Admin;"
     
     'Create RecordSet
    Set Cn = New ADODB.Connection
    
    With Cn
        .CursorLocation = adUseClient
        .Open strConnect
        Set Rs = .Execute(sSQL)
    End With
   
     'Write RecordSet to results area
    Rw = Location.Column
    Col = Location.Row
    c = Col
    Do Until Rs.EOF
        For Each MyField In Rs.Fields
                   
        'paste the value in the cell
        Cells(c, Rw) = MyField
        c = c + 1
        
        Next MyField
        
        Rs.MoveNext
        Rw = Rw + 1
        c = Col
    Loop
    Set Location = Nothing
    Set Cn = Nothing

 

[mrfitness]

Does anyone have any help on the 'file already in use' error? I am getting more user errors!

Do you think it would help if I use the close statement after?

    With Cn
        .CursorLocation = adUseClient
        .Close
    End With

 

[RoryA]

It is always best to close the connection as soon as possible (which in your case is just after you open the recordset). You may also want to look at the Range object's CopyFromRecordset method which is much faster than your cell by cell copy.

 

[mrfitness]

Thanks! So you are suggesting I do:

    With Cn
        .CursorLocation = adUseClient
        .Open strConnect
        Set Rs = .Execute(sSQL)
    End With

    With Cn
        .CursorLocation = adUseClient
        .Close
    End With

Rw = Location.Row
    Col = Location.Column
    'c = Col
    Do Until Rs.EOF
        For Each MyField In Rs.Fields
       
            Cells(Rw, Col) = MyField
       
            c = c + 1
        
        Next MyField
        Rs.MoveNext
        Rw = Rw + 1
        c = Col
    Loop

Can I still use 'Rs.Fields' after I close the connection?

Also, can you show me how I can transform my code into CopyFromRecordset (I am new to this quering Access in VBA)

Kindest Regards

It is always best to close the connection as soon as possible (which in your case is just after you open the recordset). You may also want to look at the Range object's CopyFromRecordset method which is much faster than your cell by cell copy.

 

[RoryA]

Close - I am suggesting:

With Cn
            .CursorLocation = adUseClient
            .Open strConnect
            Set Rs = .Execute(sSQL)
   .Close
    End With
If Not Rs.EOF Then Location.CopyFromRecordset Rs
Rs.Close
Set Rs = Nothing
Set Cn = Nothing

 

[mrfitness]

Thank you again.

One last question for the copy from recordset.
If my query result gives me 1 record row of 10 columns, but I want to paste it in Excel in 1 column and 10 rows, how can I go about doing that?

Close - I am suggesting:

With Cn
            .CursorLocation = adUseClient
            .Open strConnect
            Set Rs = .Execute(sSQL)
   .Close
    End With
If Not Rs.EOF Then Location.CopyFromRecordset Rs
Rs.Close
Set Rs = Nothing
Set Cn = Nothing

 

[mrfitness]

I found an error on the 'If Not Rs.EOF' line that states
"Operation is not allowed when the object is closed"

So I had to move the Cn.Close statement after that line and it worked

Close - I am suggesting:

With Cn
            .CursorLocation = adUseClient
            .Open strConnect
            Set Rs = .Execute(sSQL)
   .Close
    End With
If Not Rs.EOF Then Location.CopyFromRecordset Rs
Rs.Close
Set Rs = Nothing
Set Cn = Nothing

 

[mrfitness]

I implemented the Cn.Close statement after I copied the data from the recordset, but I am still getting the same error at time from users in different cities (I cannot duplicate the error from my office)
Error Number: -2147467259
Error Description: Could not use ''; file already in use. :

I imagine it errors either on the open connection statement or executing the SQL statement. Is there anyway I can add a loop to catch this error first, then re-attempt to open and run SQL without crashing?

Close - I am suggesting:

With Cn
            .CursorLocation = adUseClient
            .Open strConnect
            Set Rs = .Execute(sSQL)
   .Close
    End With
If Not Rs.EOF Then Location.CopyFromRecordset Rs
Rs.Close
Set Rs = Nothing
Set Cn = Nothing