Re: How Can Users Without Access Do Data Entry

Pete,

Would you please email the sample MS Access DB and accompanying MS Excel
spreadsheet to [EMAIL PROTECTED]

Thank you,

Heather



"(Pete Cresswell)" <[EMAIL PROTECTED]> wrote in message
news:[EMAIL PROTECTED]
> RE/
> >
> >Could you provide some pseudo code on how to do it with Excel. I'd be
> >particularly interested in seeing how to append to the Access table using
DAO.
>
> I sent a sample MS Access DB and accompanying MS Excel spreadsheet via email.
> If you didn't get them, let me know here and I'll send again.
>
> Here's the code that is in the sample spreadsheet.  What's missing
> is the query and table that are in the DB.
> --------------------
> Sub peopleAdd()
> 1000 On Error GoTo peopleAdd_err
>
>    ' PURPOSE: To add the people's names shown on spreadsheet to
>    '          an MS Access DB and then to clear the newly-added
>    '          names from the sheet
>    '   NOTES: 1) This routine requires Tools|References|Microsoft DAO 3.6
Object
> Library to be selected
>    '          2) The line numbers are not necessary - just a convenience when
> debugging.  Most VB programmers
>    '             do not use them.   OTOH I live and die by them.
>    '          3) We wrap the adds in a transaction so that if one thing fails,
> nothing gets added to
>    '             the DB or deleted from the sheet
>
> 1001 Dim thisSheet    As Worksheet
>      Dim thisWS       As DAO.Workspace
>      Dim peopleDB     As DAO.database
>      Dim peopleRS     As DAO.Recordset
>      Dim myQuery      As DAO.QueryDef
>
>      Dim i            As Long
>      Dim myTimeStamp  As Variant
>      Dim myPeopleList As String
>      Dim transOpen    As Boolean
>      Dim addCount     As Long
>      Dim errCount     As Long
>
>      Const myPath = "C:\Temp\DaoFromExcelTest.mdb"
>      Const firstPersonRow = 3
>      Const lastPersonRow = 32
>
>      Const lastNameCol = 7
>      Const firstNameCol = 8
>      Const middleNameCol = 9
>      Const errorCol = 10
>
>      Const nameMin = 2
>
> 1010 Set thisWS = DBEngine(0)
> 1011 Set thisSheet = Worksheets(1)
> 1012 Set peopleDB = thisWS.OpenDatabase(myPath)
> 1013 Set peopleRS = peopleDB.OpenRecordset("tblPerson", dbOpenDynaset,
> dbAppendOnly)
> 1019 myTimeStamp = Now()
>
> 1020 With thisSheet          'Clear any previous errors
> 1021    For i = firstPersonRow To lastPersonRow
> 1022       .Cells(i, errorCol) = ""
> 1023    Next i
> 1029 End With
>
> 1030 With thisSheet          'Check for errors, abort the save any errors
found
> 1031    For i = firstPersonRow To lastPersonRow
> 1032       If Len(.Cells(i, lastNameCol) & .Cells(i, firstNameCol) & .Cells(i,
> middleNameCol)) > 0 Then
> 1033          If Len(.Cells(i, lastNameCol)) < nameMin Then
> 1034             .Cells(i, errorCol) = "* Name < " & Str(nameMin) & "
> characters."
> 1035             errCount = addCount + 1
> 1036          End If
> 1037       End If
> 1038    Next i
> 1039 End With
>
> 1300 If errCount = 0 Then
> 1301    With thisSheet
> 1302       For i = firstPersonRow To lastPersonRow
> 1303          If Len(.Cells(i, lastNameCol) & .Cells(i, firstNameCol) &
> .Cells(i, middleNameCol)) > 0 Then
> 1304             peopleRS.AddNew
> 1305             peopleRS!NameLast = .Cells(i, lastNameCol)
> 1306             peopleRS!NameFirst = .Cells(i, firstNameCol)
> 1309             peopleRS!NameMiddle = .Cells(i, middleNameCol)
> 1310             peopleRS!CreatedAt = myTimeStamp
> 1311             peopleRS.Update
> 1312             addCount = addCount + 1
> 1313          End If
> 1314       Next i
> 1319    End With
>
> 1340    If addCount = 0 Then
> 1341       MsgBox "Nobody was added.  Did you type anybody in?",
vbexclaimation,
> "Oops!"
> 1349    Else
> 1359       Set peopleRS = Nothing
>
> 1510       Set myQuery = peopleDB.QueryDefs("qryPeopleByTimeStamp")
> 1511       With myQuery
> 1512          .Parameters("theTimeStamp") = myTimeStamp
> 1513          Set peopleRS = .OpenRecordset(dbOpenSnapshot, dbForwardOnly)
> 1519       End With
>
> 1520       With peopleRS
> 1521          If Not ((.BOF = True) And (.EOF = True)) Then
> 1522             Do Until .EOF = True
> 1523                If Len(myPeopleList) = 0 Then
> 1524                   myPeopleList = !NameLast & ", " & !NameFirst & " " &
> !NameMiddle
> 1525                Else
> 1529                   myPeopleList = myPeopleList & vbCrLf & !NameLast & ", "
&
> !NameFirst & " " & !NameMiddle
> 1530                End If
> 1531                .MoveNext
> 1532             Loop
> 1533             MsgBox myPeopleList, vbOKOnly + vbInformation, "These People
> Were Added"
> 1534          End If
> 1539       End With
>
> 1990       With thisSheet    'if we got this far, delete the entered names and
> commit the transaction
> 1991          For i = firstPersonRow To lastPersonRow
> 1992             .Cells(i, lastNameCol) = ""
> 1993             .Cells(i, firstNameCol) = ""
> 1994             .Cells(i, middleNameCol) = ""
> 1995          Next i
> 1996       End With
> 1997    End If
> 1999 End If
>
> peopleAdd_xit:
>  On Error Resume Next
>  peopleRS.Close
>  Set peopleRS = Nothing
>  Set peopleDB = Nothing
>  Set thisWS = Nothing
>  Set thisSheet = Nothing
>  Exit Sub
>
> peopleAdd_err:
>  MsgBox "At Line " & Erl & ": Error# " & Err & " '" & Error$ & "'.", vbOKOnly,
> "There's Trouble In River City!"
>  If transOpen = True Then
>     thisWS.Rollback
>  End If
>  Resume peopleAdd_xit
> End Sub
> --------------------
> --
> PeteCresswell