You should not create separate columns (fields) in the table for each
partner; that's bad database design as the table is not normalized and will
cause you problems later on. In a relational database like Access the way to
do it is to have separate Partners table with a foreign key column
referencing the primary key of your current table, and a text column Partner
to hold the Partner values.
Lets assume that your current able is called Companies and has a numeric
primary key column, CompanyID, e.g. an autonumber. If the CompanyID of the
row with partners A,B,C is 42 then the Partners table would have rows:
CompanyID Partner
42 A
42 B
42 C
Note that the CompanyID in partners is not an autonumber but a
straightforward long integer number data type.
You can automate the parsing of the current Partners values and the
insertion of new rows into the Partners table with some VBA code. Paste the
following procedure into a standard module. You can either use an existing
module or create a new one. In either case go to its 'declarations' area and
paste the procedure in below the lines already there. Then, if it’s a new
module, save it with a name other than the name of the procedure, e.g.
mdlPartnerStuff. Change the references in the code to the Companies table
and CompanyID column names to your actual ones (you can do a 'Replace…' from
the edit menu for this). Remember that if an object name has spaces or other
special characters in it you need to enclose it in square brackets, e.g.
[Company ID]. Once you've pasted it in and made the necessary amendments you
can run it simply by pressing the F5 key while the cursor is anywhere in the
procedure. Hopefully you won't get any errors, but if you do post back with
the details.
''''code begins''''
Public Sub ParsePartners()
Const NOMORECOMMAS = 5
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
Dim strSQL As String
Dim strPartners As String
Dim strPartner As String
Dim lngCompanyID As Long
Dim intCommaPos As Integer
Dim blnLastPartner As Boolean
strSQL = _
"SELECT CompanyID, Partners " & _
"FROM Companies_1"
Set rst = New ADODB.Recordset
rst.ActiveConnection = CurrentProject.Connection
rst.Open _
Source:=strSQL, _
CursorType:=adOpenForwardOnly
Set cmd = New ADODB.Command
cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandType = adCmdText
With rst
Do While Not .EOF
intCommaPos = 1
blnLastPartner = False
If Not IsNull(.Fields("Partners")) Then
lngCompanyID = .Fields("CompanyID")
strPartners = .Fields("Partners")
' loop through Partners value and parse
' into individual values
Do
intCommaPos = InStr(1, strPartners, ",")
' if no more commas are found an error will
' be raised to handle this
On Error Resume Next
strPartner = Trim(Left(strPartners, intCommaPos - 1))
Select Case Err.Number
Case 0
' no error
Case NOMORECOMMAS
' partner is remainder of string
strPartner = Trim(strPartners)
blnLastPartner = True
Case Else
' unknown error
MsgBox Err.Description, vbExclamation, "Error"
End Select
' resume default error handling
On Error GoTo 0
strPartners = Mid(strPartners, intCommaPos + 1)
' execute SQL statement to insert row into Partners table
strSQL = "INSERT INTO Partners(CompanyID, Partner) " & _
"VALUES(" & lngCompanyID & ",""" & strPartner & """)"
cmd.CommandText = strSQL
cmd.Execute
If blnLastPartner Then Exit Do
Loop
End If
.MoveNext
Loop
End With
End Sub
''''code ends''''
Ken Sheridan
Stafford, England
