Append Data To Access Table
 

There is an Access table on the network. 15 users who do not have Access are
connected to the network. Is there a way for each user to be able to enter one
or more rows containing 3 or 4 columns to Excel on his machine and then press a
button or something and append that data to the Access table on the network?
Also would need to delete the data from the worksheet after the append. How
would I prevent more than one user from appending data at the same time? Any
suggestions on what the code would be?

Thank you very much!

Martin

Append Data To Access Table
 

Martin wrote:
There is an Access table on the network. 15 users who do not have Access are
connected to the network. Is there a way for each user to be able to enter one
or more rows containing 3 or 4 columns to Excel on his machine and then press a
button or something and append that data to the Access table on the network?


Yes.

The following example shows 2 ways to do this using DAO. You will need a
reference from the workbook's VBProject to an appropriate Microsoft DAO N.N
library (may depend on your version of Access).

Sub Test()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Set DB = OpenDatabase("C:\WNXLPG5\DATA\Orders9a.mdb")
Set RS = DB.OpenRecordset("Customers", dbOpenDynaset)
CopyToRecordset Sheets("Sheet1").Range("A1"), RS
RS.Close
End Sub

Sub CopyToRecordset(DataRange As Range, RS As DAO.Recordset)
Dim rRegion As Range
Dim rCell As Range
Dim lRow As Long
Dim iCol As Integer
On Error GoTo InitErr
Set rRegion = DataRange.CurrentRegion
For Each rCell In rRegion.Rows(1).Cells
' match the field names
If Not IsIn(RS.Fields, rCell.Value) Then
MsgBox "Field '" & rCell.Value & "' is not in the recordset"
' make the heading red to indicate problem
rCell.Font.ColorIndex = 3
Exit Sub
End If
Next
On Error GoTo RecordErr
For lRow = 2 To rRegion.Rows.Count
RS.AddNew
For iCol = 1 To rRegion.Columns.Count
RS.Fields(rRegion.Cells(1, iCol).Value) = rRegion.Cells(lRow, iCol).Value
Next
RS.Update
Next
Exit Sub
InitErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, _
"CopyFromRecordset Initialisation"
Exit Sub
RecordErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, _
"CopyFromRecordset Record " & lRow
If iCol 0 Then
rRegion.Cells(lRow, iCol).Font.ColorIndex = 3
End If
Resume Next
End Sub

' alternate means
Sub SQLTest()
Dim DB As DAO.Database
Set DB = OpenDatabase("C:\WNXLPG5\DATA\Orders9.mdb")
SQLCopyToRecordset Sheets("Sheet1").Range("A1"), DB, "Customers"
End Sub


Sub SQLCopyToRecordset(DataRange As Range, DB As Database, TableName As String)
Dim rRegion As Range
Dim rCell As Range
Dim lRow As Long
Dim iCol As Integer
Dim stFList As String
Dim stVList As String
On Error GoTo RecordErr
Set rRegion = DataRange.CurrentRegion
stFList = ""
For Each rCell In rRegion.Rows(1).Cells
' list the field names
If stFList < "" Then stFList = stFList & ", "
stFList = stFList & "[" & rCell.Value & "]"
Next
For lRow = 2 To rRegion.Rows.Count
stVList = ""
For iCol = 1 To rRegion.Columns.Count
If stVList < "" Then stVList = stVList & ", "
If TypeName(rRegion.Cells(lRow, iCol).Value) = "String" Then
stVList = stVList & "'" & rRegion.Cells(lRow, iCol).Value & "'"
ElseIf TypeName(rRegion.Cells(lRow, iCol).Value) = "Empty" Then
stVList = stVList & "Null"
Else
stVList = stVList & rRegion.Cells(lRow, iCol).Value
End If
Next
DB.Execute "INSERT INTO " & TableName & " (" & stFList & ") VALUES (" &
stVList & ")"
Next
Exit Sub
RecordErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, _
"SQLCopyToRecordset Record " & lRow
If iCol 0 Then
rRegion.Cells(lRow, iCol).Font.ColorIndex = 3
End If
Resume Next
End Sub

Function IsIn(oCollection As Object, stName As String) As Boolean
Dim O As Object
On Error GoTo NotIn
Set O = oCollection(stName)
IsIn = True
Exit Function
NotIn:
IsIn = False
End Function



Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - reply in newsgroup

Append Data To Access Table
 

Bill,

Thanks for the response!

The 15 users do not have Access installed so will not be able to open a
database.

Martin


"Bill Manville" wrote in message
...
Martin wrote:
There is an Access table on the network. 15 users who do not have Access are
connected to the network. Is there a way for each user to be able to enter
one
or more rows containing 3 or 4 columns to Excel on his machine and then
press a
button or something and append that data to the Access table on the network?


Yes.

The following example shows 2 ways to do this using DAO. You will need a
reference from the workbook's VBProject to an appropriate Microsoft DAO N.N
library (may depend on your version of Access).

Sub Test()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Set DB = OpenDatabase("C:\WNXLPG5\DATA\Orders9a.mdb")
Set RS = DB.OpenRecordset("Customers", dbOpenDynaset)
CopyToRecordset Sheets("Sheet1").Range("A1"), RS
RS.Close
End Sub

Sub CopyToRecordset(DataRange As Range, RS As DAO.Recordset)
Dim rRegion As Range
Dim rCell As Range
Dim lRow As Long
Dim iCol As Integer
On Error GoTo InitErr
Set rRegion = DataRange.CurrentRegion
For Each rCell In rRegion.Rows(1).Cells
' match the field names
If Not IsIn(RS.Fields, rCell.Value) Then
MsgBox "Field '" & rCell.Value & "' is not in the recordset"
' make the heading red to indicate problem
rCell.Font.ColorIndex = 3
Exit Sub
End If
Next
On Error GoTo RecordErr
For lRow = 2 To rRegion.Rows.Count
RS.AddNew
For iCol = 1 To rRegion.Columns.Count
RS.Fields(rRegion.Cells(1, iCol).Value) = rRegion.Cells(lRow,
iCol).Value
Next
RS.Update
Next
Exit Sub
InitErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, _
"CopyFromRecordset Initialisation"
Exit Sub
RecordErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, _
"CopyFromRecordset Record " & lRow
If iCol 0 Then
rRegion.Cells(lRow, iCol).Font.ColorIndex = 3
End If
Resume Next
End Sub

' alternate means
Sub SQLTest()
Dim DB As DAO.Database
Set DB = OpenDatabase("C:\WNXLPG5\DATA\Orders9.mdb")
SQLCopyToRecordset Sheets("Sheet1").Range("A1"), DB, "Customers"
End Sub


Sub SQLCopyToRecordset(DataRange As Range, DB As Database, TableName As
String)
Dim rRegion As Range
Dim rCell As Range
Dim lRow As Long
Dim iCol As Integer
Dim stFList As String
Dim stVList As String
On Error GoTo RecordErr
Set rRegion = DataRange.CurrentRegion
stFList = ""
For Each rCell In rRegion.Rows(1).Cells
' list the field names
If stFList < "" Then stFList = stFList & ", "
stFList = stFList & "[" & rCell.Value & "]"
Next
For lRow = 2 To rRegion.Rows.Count
stVList = ""
For iCol = 1 To rRegion.Columns.Count
If stVList < "" Then stVList = stVList & ", "
If TypeName(rRegion.Cells(lRow, iCol).Value) = "String" Then
stVList = stVList & "'" & rRegion.Cells(lRow, iCol).Value & "'"
ElseIf TypeName(rRegion.Cells(lRow, iCol).Value) = "Empty" Then
stVList = stVList & "Null"
Else
stVList = stVList & rRegion.Cells(lRow, iCol).Value
End If
Next
DB.Execute "INSERT INTO " & TableName & " (" & stFList & ") VALUES (" &
stVList & ")"
Next
Exit Sub
RecordErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, _
"SQLCopyToRecordset Record " & lRow
If iCol 0 Then
rRegion.Cells(lRow, iCol).Font.ColorIndex = 3
End If
Resume Next
End Sub

Function IsIn(oCollection As Object, stName As String) As Boolean
Dim O As Object
On Error GoTo NotIn
Set O = oCollection(stName)
IsIn = True
Exit Function
NotIn:
IsIn = False
End Function



Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - reply in newsgroup

Append Data To Access Table
 

Martin wrote:
The 15 users do not have Access installed so will not be able to open a
database.


Sorry, but that is not the case.
Try it.
They only need the DAO library which certainly comes with Office, whether
or not they have Access.

Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - reply in newsgroup