Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Using Excel VBA: sending output data table to created .csv file +append Options | Excel Discussion (Misc queries) | |||
Export Single Record to Append to Access Table | Excel Discussion (Misc queries) | |||
How to Append the Data to the Master Table | Excel Worksheet Functions | |||
Append Data In Worksheet To Access Table | Excel Programming | |||
Excel data to an Access table | Excel Programming |