Remove or Bypass the 'File Reservation' Dialogue?

[phendrena]

Hi,

Is it possible to bypass, skip or ignore the File Reservation dialogue to allow more than one user the ability to modify a document without 'sharing' the workbook?

The reason is as follows :-
I have a workbook that is used by several users at one time, this workbook is password protected so users can't modify anything.
It is perfectly fine for them to open it as Read-Only as the excel workbook only serves as a front-end data entry system as all the actual data is held in access.
Under certain controlled circumstances, multiple users would need the ability to amend the various lookup tables. To this i need the ability to bypass the 'file reservation' dialogue.

I have the following code which changes the permission of the workbook from Read-Only to Read/Write and visa-versa.
[vba]
'--- Read/Write
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, WritePassword:="password"
'--- Read Only
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly, WritePassword:="password"[/vba]

However, when you run the code to change it from read-only the 'file reservation' dialogue appears.

Is anyone able to help with this query?

[Bob Phillips]

Why aren't the lookup tables held in Access as well?

[phendrena]

Why aren't the lookup tables held in Access as well?

The lookup tables hold the data to populate various listboxes, comboboxes and perform validation checks against the windows logon username.

I thought it'd be far easier to keep these held on the spreadsheet rather than pulling the data from access.

[Bob Phillips]

Personally, I would store themk in Access and load them at workbook open. The display spreadsheet should hold no data in my view of these things.

[phendrena]

Personally, I would store themk in Access and load them at workbook open. The display spreadsheet should hold no data in my view of these things.

Would you then load them into a worksheet? I could get quite tricky as i use a of name ranges (standard and dynamic).

[Bob Phillips]

I would, I do. What you mention is not a problem, create the range names dynamically, after loading into the worksheet.

Using ADO and CopyFromRecordset you have a simple means of getting the data and dropping into a worksheet.

[Bob Phillips]

You can maintain the data either directly in Access, or build an Excel/VB front-en d to manage that.

[phendrena]

I would, I do. What you mention is not a problem, create the range names dynamically, after loading into the worksheet.

Using ADO and CopyFromRecordset you have a simple means of getting the data and dropping into a worksheet.

Would you be able to provide an example please, i'm not sure how you would create the named range after loading the data into the worksheet and i'm not 100% on actually getting the data into a worksheet.

Strangely though......

You can maintain the data either directly in Access, or build an Excel/VB front-en d to manage that.

This i can do. I already have a record search and update in place so that could be adjusted quite easily.

[Bob Phillips]

here is a very simple example

[vba]

Sub GetData()
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
Dim RS As Object
Dim sConnect As String
Dim sSQL As String
Dim LastRow As Long

sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & "c:\test\bob.mdb"

sSQL = "SELECT * From Contacts"
Set RS = CreateObject("ADODB.Recordset")
RS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' Check to make sure we received data.
If Not RS.EOF Then
Range("H1").Value = "First Name"
Range("I1").Value = "Last Name"
Range("J1").Value = "Phone"
Range("K1").Value = "County"
Range("H2").CopyFromRecordset RS

LastRow = Range("H1").End(xlDown).Row
Range("H1").Resize(LastRow, 4).Name = "myTable"
Else
MsgBox "No records returned.", vbCritical
End If

RS.Close
Set RS = Nothing
End Sub
[/vba]

[phendrena]

Hi xld,

Thanks for the reply and ongoing support with this one.
I have modified the code to point to my database and set the column headers appropriate, however I am now getting the following error :-

'Class doesn't support Automation'

Debug highlights the following : 'ws.Range("H2").CopyFromRecordset RS'

[vba]Sub GetData()
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
Dim RS As Object
Dim sConnect As String
Dim sSQL As String
Dim LastRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Lookups")
sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & "S:\BTeams\Ford\DST\Call Log Database\Database\DST Database.mdb"
sSQL = "SELECT * From StaffList"
Set RS = CreateObject("ADODB.Recordset")
RS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
' Check to make sure we received data.
If Not RS.EOF Then
ws.Range("H1").Value = "CustomerManager"
ws.Range("I1").Value = "Site"
ws.Range("J1").Value = "EmailSubject"
ws.Range("K1").Value = "TeamLeader"
ws.Range("L1").Value = "TCM"
ws.Range("H2").CopyFromRecordset RS

LastRow = ws.Range("H1").End(xlDown).Row
ws.Range("H1").Resize(LastRow, 5).Name = "StaffList"
Else
MsgBox "No records returned.", vbCritical
End If
RS.Close
Set RS = Nothing
End Sub[/vba]

The code has been placed into a normal module and run from there.

Do you have any suggestions?

Thanks,

[Bob Phillips]

No, I am lost on that one. Any chance that you can post the database and workbook?

[phendrena]

Sure.
These are examples not the actually files as they would require massive stripping, however they error just the same.You'll need to change the filename and path accordingly.

[Bob Phillips]

I have just run it and I don't get that problem.

[phendrena]

Hmmmm..... a problem with Excel '97 perhaps?

[Bob Phillips]

I have just remembered, you have Excel 97? CopyRecordset was not available to 97. We could use GetRows into an array and dump that, but you have nulls in the data. Can they be removed in your database?

[Bob Phillips]

Try this

[vba]

Sub GetData()
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
Dim RS As Object
Dim sConnect As String
Dim sSQL As String
Dim LastRow As Long
Dim ary As Variant
Dim i As Long
Dim j As Long

Dim ws As Worksheet
Set ws = Worksheets("Lookups")

sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & "S:\BTeams\Ford\DST\Call Log Database\Database\DST Database.mdb"

sSQL = "SELECT * From StaffList"
Set RS = CreateObject("ADODB.Recordset")
RS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' Check to make sure we received data.
If Not RS.EOF Then
ws.Range("H1").Value = "CustomerManager"
ws.Range("I1").Value = "Site"
ws.Range("J1").Value = "EmailSubject"
ws.Range("K1").Value = "TeamLeader"
ws.Range("L1").Value = "TCM"
ary = RS.getrows
For i = LBound(ary, 1) To UBound(ary, 1)

For j = LBound(ary, 2) To UBound(ary, 2)

If IsNull(ary(i, j)) Then ary(i, j) = ""
Next j
Next i
ws.Range("H2").Resize(UBound(ary, 2), UBound(ary, 1)) = Application.Transpose(ary)
'ws.Range ("H2") =
LastRow = ws.Range("H1").End(xlDown).Row
ws.Range("H2").Resize(LastRow, 5).Name = "myTable"
Else
MsgBox "No records returned.", vbCritical
End If

RS.Close
Set RS = Nothing
End Sub
[/vba]

[phendrena]

If by nulls you mean blank fields, then there will be some blank fields as not all TeamLeaders have an associated TCM.
The code does work nicely, but doesn't import the TCM field. I assume this is due to the blanks?

Edit : The code also misses off the last record when it brings the data into excel.

[Bob Phillips]

No, not the blanks, it is down to my crap code, I was mishandling the array size (same problem on last record).

This should be better

[vba]

Sub GetData()
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
Dim RS As Object
Dim sConnect As String
Dim sSQL As String
Dim LastRow As Long
Dim ary As Variant
Dim i As Long
Dim j As Long

Dim ws As Worksheet
Set ws = Worksheets("Lookups")

sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & "C:\Example1.mdb"

sSQL = "SELECT * From StaffList"
Set RS = CreateObject("ADODB.Recordset")
RS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' Check to make sure we received data.
If Not RS.EOF Then
ws.Range("H1").Value = "CustomerManager"
ws.Range("I1").Value = "Site"
ws.Range("J1").Value = "EmailSubject"
ws.Range("K1").Value = "TeamLeader"
ws.Range("L1").Value = "TCM"
ary = RS.getrows
For i = LBound(ary, 1) To UBound(ary, 1)

For j = LBound(ary, 2) To UBound(ary, 2)

If IsNull(ary(i, j)) Then ary(i, j) = ""
Next j
Next i
ws.Range("H2").Resize(UBound(ary, 2) - LBound(ary, 2) + 1, UBound(ary, 1) - LBound(ary, 1) + 1) = Application.Transpose(ary)
'ws.Range ("H2") =
LastRow = ws.Range("H1").End(xlDown).Row
ws.Range("H2").Resize(LastRow, 5).Name = "myTable"
Else
MsgBox "No records returned.", vbCritical
End If

RS.Close
Set RS = Nothing
End Sub
[/vba]

[phendrena]

Nice one xld.
I wouldn't call your code crap though, mine yes, yours no
I assume i can modify the sSQL statement to include other standard SQL statements, for example to split the staff list into alphabetical sections by using WHERE and LIKE etc.

I'm not going to mark this thread as solved as it could be misleading as we went off from the actual subject.

[Bob Phillips]

Absolutely. You can modify the SQL, filter the recordset, or do it in the spreadsheet. SQL is the obvious choice, but you have options.