CODEWITHSUNDEEP
excelvbams-access
BearsRfuk
BearsRfuk

Reputation: 23

Updating Access DB from Excel

I am trying to use excel as a front end to update an access database with user inputs. However, I can not get this query to function properly. Currently, I have gotten the error message;

Run-time error '-2147467259 (80004005)': Cannot Update. Database or object is read-only.

I know the file is not stored in a location that is write protected and the file itself is not either. Opening the file itself on any users computer will allow them to write to it, but the code is blocking itself somehow. This is Excel and Access 2007. Code below;

       Sub PopulateOneField()
 Const TARGET_DB = "P:\Master\Part Number List.accdb"
   Dim cnn As ADODB.Connection
   Dim MyConn
   Dim rst As ADODB.Recordset
   Dim i As Long, j As Long
   Dim Rw As Long
   Dim sSQL As String

   Sheets("Sheet2").Activate
   Rw = Range("A65536").End(xlUp).Row

   Set cnn = New ADODB.Connection
     MyConn = TARGET_DB
    MyConn = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};DBQ=" & MyConn

   With cnn
     .Open MyConn
   End With

   Set rst = New ADODB.Recordset
   rst.CursorLocation = adUseServer
   For i = 3 To Rw
     sSQL = "SELECT * FROM sheet2"
     rst.Open Source:=sSQL, _
              ActiveConnection:=cnn, _
              CursorType:=adOpenKeyset, _
              LockType:=adLockOptimistic
     rst(Cells(1, 3).Value) = Cells(i, 3).Value
     rst.Update
     rst.Close
   Next i

   cnn.Close
   Set rst = Nothing
   Set cnn = Nothing

End Sub

Thanks in advance.

Upvotes: 0

Views: 520

Answers (1)

HackSlash
HackSlash

Reputation: 5805

I wrote a simple class for this purpose. It looks like this:

Option Explicit

' ConnectModeEnum
'Private Const adModeRead = 1
'Private Const adModeReadWrite = 3
Private Const adModeShareDenyNone As Long = 16

' adStateEnum
'Const adStateClosed As Long = 0                  'Indicates that the object is closed.
Const adStateOpen As Long = 1                    'Indicates that the object is open.
'Const adStateConnecting As Long = 2              'Indicates that the object is connecting.
'Const adStateExecuting As Long = 4               'Indicates that the object is executing a command.
'Const adStateFetching As Long = 8                'Indicates that the rows of the object are being retrieved.

' CursorTypeEnum
Const adOpenStatic As Long = 3

' LockTypeEnum
Const adLockOptimistic As Long = 3

Private dataSource As Object

Public FileName As String

Public Property Get Connection() As Object
    If dataSource Is Nothing Then
        Set dataSource = CreateObject("ADODB.Connection")
        
        With dataSource
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .Mode = adModeShareDenyNone
        End With
    End If
    
    Set Connection = dataSource
End Property

Public Sub Connect(ByVal dataBaseName As String)
    Connection.Open "Data Source=" & dataBaseName & ";"
End Sub

''' Recordset command is used to access table data
Public Function Record(ByVal sqlQuery As String) As Object
    If Not ((Connection.state And adStateOpen) = adStateOpen) Then
        Connect FileName
    End If
    
    Set Record = CreateObject("ADODB.Recordset")
    Record.Open Source:=sqlQuery, ActiveConnection:=Connection, CursorType:=adOpenStatic, LockType:=adLockOptimistic
End Function

Public Sub Dispose()
    If dataSource Is Nothing Then
        Debug.Print "You disposed of nothing..."
    Else
        If (Connection.state And adStateOpen) = adStateOpen Then dataSource.Close
        Set dataSource = Nothing
    End If
End Sub

Once you have that in a class module you can use it like this:

Dim myDB As AccessBackEnd
Set myDB = New AccessBackEnd
myDB.FileName = TARGET_DB

With myDB.Record(sSQL)
    .Fields(Cells(1, 3).Value) = Cells(i, 3).Value
    .Update
End With

myDB.Dispose

That said, your logic doesn't make sense. You are setting the same field 3 times. It's always going to hold the final value. So why do it 3 times?

Upvotes: 1

Related Questions