Drive Mapping Required

[JDU]

I have a machine that I am trying to connect to using the following code. I don't have admin rights on the box, however the account wsservice does. I am using this account in the code to make the connection.

Result: If I have a drive mapped to the machine with the account wsservice then the code functions just fine. If I don't have a drive mapping it doesn't work and gives me an error. How can I fix this. Thanks.

Public Sub Test()

Dim arrarray
Dim Path As String

arrarray = Array("ppalab005", "plabbank01", "plabbank02", "plbcl03")

For j = LBound(arrarray) To UBound(arrarray)
Path = "\\" & arrarray(j) & "\c$\Test\Test_db1.mdb;"

Dim objConn As New Connection
objConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=" & Path & _
"Uid=wsservice;" & _
"Pwd=*********"

Dim objRS As New Recordset
objRS.Open "Insert_Errors", objConn, , adLockOptimistic, adCmdTable

objRS.AddNew
objRS!MRN = Form_frmManualEntry.txtMRN
objRS!Name = Form_frmManualEntry.txtName
objRS!Birth = Form_frmManualEntry.txtBirth
objRS!ABO_Rh = Form_frmManualEntry.txtABO_Rh
objRS!Phenotype = Form_frmManualEntry.txtPhenotype
objRS!TransReqs = Form_frmManualEntry.txtTransReqs
objRS!Antibodies = Form_frmManualEntry.txtAntibodies
objRS!Antigens = Form_frmManualEntry.txtAntigens
objRS!Comments = Form_frmManualEntry.txtComments
objRS.Update

objRS.Close

Set objRS = Nothing

objConn.Close

Set objConn = Nothing
Next

End Sub

 

[vbajock]

You might start by telling us what the error is.

 

[JDU]

Sorry, the error is "The Microsoft Jet database engine cannot open the file (unknown). It is already opened exclusively by another user, or you need permission to view its data".

I don't get this error if I map a drive to the machine using the admin account wsservice and then run the code.

 

[drctx]

how about this to map the drive first.

Call Shell("NET USE H: /DELETE")
Call Shell("NET USE H: " & Chr(34) & "\\Sfx02rudcar1286\c$\Tools" & Chr(34) & " password /USER:username /PERSISTENT:NO")

 

[JDU]

Thanks. I am seeing a strange behavior that I don't understand. In the following code the second machine in the array is the machine that is being used to run this code. After finishing the for loop for the second machine the code goes into ErrorHandler: and gives me a blank Msgbox.

Private Sub AddRecord()

On Error GoTo ErrorHandler


Dim arrarray
Dim Path As String
Dim dbFile As String

arrarray = Array("ppalab005", "plbcl03")

For j = LBound(arrarray) To UBound(arrarray)
Path = "\\" & arrarray(j) & "\c$\Test"
dbFile = "\\" & arrarray(j) & "\c$\Test\Test_db1.mdb;"

Call Shell("NET USE H: " & Chr(34) & "" & Path & Chr(34) & " password /USER:cernerwsservice /PERSISTENT:NO")

Dim objConn As New Connection
objConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=" & dbFile & _
"Uid=cernerwsservice;" & _
"Pwd=password"
Dim objRS As New Recordset
objRS.Open "BB_Backup", objConn, , adLockOptimistic, adCmdTable

objRS.AddNew
objRS!MRN = Form_frmManualEntry.txtMRN
objRS!Name = UCase(Form_frmManualEntry.txtName)
objRS!Birth = Format(Form_frmManualEntry.txtBirth, "m/d/yyyy")
objRS!ABO_Rh = UCase(Form_frmManualEntry.txtABO_Rh)
objRS!Phenotype = Form_frmManualEntry.txtPhenotype
objRS!TransReqs = Form_frmManualEntry.txtTransReqs
objRS!Antibodies = Form_frmManualEntry.txtAntibodies
objRS!Antigens = Form_frmManualEntry.txtAntigens
objRS!Comments = Form_frmManualEntry.txtComments
objRS.Update

objRS.Close

Set objRS = Nothing

objConn.Close

Set objConn = Nothing

Call Shell("NET USE H: /DELETE")

Next

ErrorHandler:
MsgBox Err.Description
blNotSuccessful = True
Exit Sub

End Sub

 

[PHV]

Just add an Exit Sub instruction after the Next

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244