Recently I had a two tasks in Access where I needed to do some data collection in a sort of 'survey' format. By that I mean there is this one thing and a bunch of different attributes/questions that need to be filled in/answered before the entire set can be saved. However, these things are not all the same. For one it is an invoice system where by different clients have different charge numbers but any one client always has the same st of charge numbers. Or people answering questions about pieces of equipment. Every equipment has a different set of questions but any one piece of eqipment should always have the same questions.
The hard part of doing this in Access is making dynamic forms where the number of text boxes is hard. Or displaying a bunch of different questions to be filled in (in any order) to the user with the answers being blank by default and letting them moved between sections without getting some error message that says "this value is required" but requiring an answer be selected before everything is submitted is tricky.
This is ultimately what I did to accomplish this:
Here's the code to make this schema
Option Compare Database
Option Explicit
Function MakeSurveyDatabase()
Dim CreateAnswerOption As String
Dim CreateQuestion As String
Dim CreateSurvey As String
Dim CreatePerson As String
Dim CreateSurveyQuestion As String
Dim CreateSurveyQuestionAnswerOption As String
Dim CreateSelectedAnswer As String
Dim sqlStatements As New Collection
CreateAnswerOption = "CREATE TABLE AnswerOption (" & _
" AnswerOptionID AUTOINCREMENT," & _
" AnswerText TEXT," & _
" PRIMARY KEY (AnswerOptionID)," & _
" CONSTRAINT IX_AnswerText UNIQUE (AnswerText)" & _
");"
CreateQuestion = "CREATE TABLE Question (" & _
" QuestionID AUTOINCREMENT," & _
" QuestionText TEXT," & _
" PRIMARY KEY (QuestionID)," & _
" CONSTRAINT IX_QuestionText UNIQUE (QuestionText)" & _
");"
CreateSurvey = "CREATE TABLE Survey (" & _
" SurveyID AUTOINCREMENT," & _
" SurveyName TEXT," & _
" PRIMARY KEY (SurveyID)," & _
" CONSTRAINT IX_SurveyName UNIQUE (SurveyName)" & _
");"
CreatePerson = "CREATE TABLE Person (" & _
" PersonID AUTOINCREMENT," & _
" PersonName TEXT," & _
" PRIMARY KEY (PersonID)" & _
");"
CreateSurveyQuestion = "CREATE TABLE SurveyQuestion (" & _
" SurveyID INT," & _
" QuestionID INT," & _
" foreign key (SurveyID) references Survey(SurveyID)," & _
" foreign key (QuestionID) references Question(QuestionID)," & _
" PRIMARY KEY (SurveyID,QuestionID)" & _
");"
CreateSurveyQuestionAnswerOption = "CREATE TABLE SurveyQuestionAnswerOption (" & _
" SurveyID INT," & _
" QuestionID INT," & _
" AnswerOptionID INT," & _
" foreign key (SurveyID,QuestionID) references SurveyQuestion(SurveyID,QuestionID)," & _
" foreign key (AnswerOptionID) references AnswerOption(AnswerOptionID)," & _
" PRIMARY KEY (SurveyID,QuestionID,AnswerOptionID)" & _
");"
CreateSelectedAnswer = "CREATE TABLE SelectedAnswer (" & _
" SurveyID INT," & _
" QuestionID INT," & _
" PersonID INT," & _
" SelectedAnswerID INT," & _
" AdditionalText TEXT," & _
" foreign key (SurveyID,QuestionID,SelectedAnswerID) references SurveyQuestionAnswerOption(SurveyID,QuestionID,AnswerOptionID)," & _
" foreign key(PersonID) references Person(PersonID)," & _
" PRIMARY KEY (SurveyID,QuestionID,PersonID)" & _
");"
sqlStatements.Add CreateAnswerOption
sqlStatements.Add CreateQuestion
sqlStatements.Add CreateSurvey
sqlStatements.Add CreatePerson
sqlStatements.Add CreateSurveyQuestion
sqlStatements.Add CreateSurveyQuestionAnswerOption
sqlStatements.Add CreateSelectedAnswer
ExecuteSql sqlStatements
End Function
Function ExecuteSql(sqls As Collection) As Boolean
Dim db As DAO.Database, wkspace As DAO.Workspace
Dim sql
Set db = CurrentDb
Set wkspace = DBEngine.Workspaces(0)
On Error GoTo Catcher
wkspace.BeginTrans
For Each sql In sqls
db.Execute sql
Next sql
wkspace.CommitTrans
Debug.Print "Success!"
ExecuteSql = True
Exit Function
Catcher:
If Err.Number <> 0 Then
Debug.Print Err.Description
Debug.Print "rolling back"
wkspace.Rollback
ExecuteSql = False
End If
End Function