Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 473
Default 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

  #3   Report Post  
Posted to microsoft.public.excel.programming
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



  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 473
Default 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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Using Excel VBA: sending output data table to created .csv file +append Options Mike Excel Discussion (Misc queries) 1 December 10th 11 12:39 PM
Export Single Record to Append to Access Table RMS Excel Discussion (Misc queries) 1 December 9th 08 07:08 PM
How to Append the Data to the Master Table Shiva Excel Worksheet Functions 7 November 8th 05 05:00 AM
Append Data In Worksheet To Access Table Martin[_14_] Excel Programming 4 December 3rd 03 11:52 AM
Excel data to an Access table Les[_2_] Excel Programming 6 October 13th 03 07:53 PM


All times are GMT +1. The time now is 05:15 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"