View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Martin[_14_] Martin[_14_] is offline
external usenet poster
 
Posts: 4
Default 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