By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,694 Members | 2,050 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,694 IT Pros & Developers. It's quick & easy.

Change Table Field Lookup Properties in Code?

P: n/a
Hello All,

Is it possible to change table field lookup properties in code?

I've been able to change other field properties in code, however so far
no luck with field lookup properties. What I've done for test purposes
is use a text input file for the table field lookup properties. I
thought that I'd start first by just changing the 'Display Control'
property. Thanks to Allen Browne for some ideals per
http://groups.google.com/group/comp....43d398b766f1a0

See code and input below. Hopefully wrapping won't mess everything up.

Any ideals? Thanks!

=====================>Begin Code>===================================>
Sub OpenTxtTblPropFile2()
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim fs, f, ts, s
Dim lngNbrRec As Long, lngLnLength As Long, lngTilde1 As Long, _
lngTilde2 As Long, lngTilde3 As Long, lngTilde4 As Long, _
lngTilde5 As Long, lngTilde6 As Long, lngTilde7 As Long, _
lngTilde8 As Long, lngTilde9 As Long, lngTilde10 As Long, _
lngTilde11 As Long
Dim strLn As String, strTbl As String, strFld As String, _
strDispCntl As String, strRwSrcTyp As String, strRwSrc As
String, _
strBndCol As String, strColCnt As String, strColHds As String, _
strColWidths As String, strLstRw As String, strLstWdth As
String, _
strLmtToLst As String

Dim strErrMsg As String

Dim db As DAO.Database
Dim tbl As DAO.TableDef
Dim fld As DAO.Field
Dim prp As DAO.Property

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("X:\My Documents\FileRef\Access\SQL Access to SQL
Server\Export\NWLookupProperties.txt")
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)

Set db = CurrentDb()

Do While ts.AtEndOfStream <> True
lngNbrRec = lngNbrRec + 1
strLn = ts.ReadLine
lngLnLength = Len(strLn)
lngTilde1 = 0
lngTilde2 = 0
lngTilde3 = 0
lngTilde4 = 0
lngTilde5 = 0
lngTilde6 = 0
lngTilde7 = 0
lngTilde8 = 0
lngTilde9 = 0
lngTilde10 = 0
lngTilde11 = 0
lngTilde1 = InStr(1, strLn, Chr(126), vbTextCompare)
lngTilde2 = InStr(lngTilde1 + 1, strLn, Chr(126), vbTextCompare)
lngTilde3 = InStr(lngTilde2 + 1, strLn, Chr(126), vbTextCompare)
lngTilde4 = InStr(lngTilde3 + 1, strLn, Chr(126), vbTextCompare)
lngTilde5 = InStr(lngTilde4 + 1, strLn, Chr(126), vbTextCompare)
lngTilde6 = InStr(lngTilde5 + 1, strLn, Chr(126), vbTextCompare)
lngTilde7 = InStr(lngTilde6 + 1, strLn, Chr(126), vbTextCompare)
lngTilde8 = InStr(lngTilde7 + 1, strLn, Chr(126), vbTextCompare)
lngTilde9 = InStr(lngTilde8 + 1, strLn, Chr(126), vbTextCompare)
lngTilde10 = InStr(lngTilde9 + 1, strLn, Chr(126),
vbTextCompare)
lngTilde11 = InStr(lngTilde10 + 1, strLn, Chr(126),
vbTextCompare)

' Debug.Print strLn
' Debug.Print "Line Length: "; lngLnLength
' Debug.Print "1st, 2nd, 3rd, 4th Tilde Postn: "; lngTilde1 & " "
& _
' lngTilde2 & " " & lngTilde3 & " " & lngTilde4
' Debug.Print "5th, 6th, 7th, 8th Tilde Postn: "; lngTilde5 & " "
& _
' lngTilde6 & " " & lngTilde7 & " " & lngTilde8
' Debug.Print "9th, 10th, 11th Tilde Postn: "; lngTilde9 & " " &
_
' lngTilde10 & " " & lngTilde11

strTbl = Mid(strLn, 2, lngTilde1 - 3)
strFld = Mid(strLn, lngTilde1 + 2, lngTilde2 - lngTilde1 - 3)
strDispCntl = Mid(strLn, lngTilde2 + 2, lngTilde3 - lngTilde2 -
3)
strRwSrcTyp = Mid(strLn, lngTilde3 + 2, lngTilde4 - lngTilde3 -
3)
strRwSrc = Mid(strLn, lngTilde4 + 2, lngTilde5 - lngTilde4 - 3)
strBndCol = Mid(strLn, lngTilde5 + 2, lngTilde6 - lngTilde5 - 3)
strColCnt = Mid(strLn, lngTilde6 + 2, lngTilde7 - lngTilde6 - 3)
strColHds = Mid(strLn, lngTilde7 + 2, lngTilde8 - lngTilde7 - 3)
strColWidths = Mid(strLn, lngTilde8 + 2, lngTilde9 - lngTilde8 -
3)
strLstRw = Mid(strLn, lngTilde9 + 2, lngTilde10 - lngTilde9 - 3)
strLstWdth = Mid(strLn, lngTilde10 + 2, lngTilde11 - lngTilde10
- 3)
strLmtToLst = Mid(strLn, lngTilde11 + 2, lngLnLength -
lngTilde11 - 2)

' Debug.Print strLn
Debug.Print "Table: "; strTbl
Debug.Print "Field: "; strFld
Debug.Print "Display Control: "; strDispCntl
' Debug.Print "Row Source Type: "; strRwSrcTyp
' Debug.Print "Row Source: "; strRwSrc
' Debug.Print "Bound Column: "; strBndCol
' Debug.Print "Column Count: "; strColCnt
' Debug.Print "Column Heads: "; strColHds
' Debug.Print "Column Widths: "; strColWidths
' Debug.Print "Lists Rows: "; strLstRw
' Debug.Print "List Width: "; strLstWdth
' Debug.Print "Limit To List: "; strLmtToLst
Set tbl = db.TableDefs(strTbl)
Set fld = tbl.Fields(strFld)
Call SetPropertyDAO(fld, "DisplayControl", dbText, strDispCntl,
_
strErrMsg)
Loop
Debug.Print lngNbrRec

ts.Close

Set prp = Nothing
Set fld = Nothing
Set tbl = Nothing
Set db = Nothing
Application.RefreshDatabaseWindow
End Sub
Function SetPropertyDAO(obj As Object, strPropertyName As String, _
intType As Integer, varValue As Variant, _
Optional strErrMsg As String) As Boolean
On Error GoTo ErrHandler
'Purpose: Set a property for an object, creating if necessary.
'Arguments: obj = the object whose property should be set.
' strPropertyName = the name of the property to set.
' intType = the type of property (needed for creating)
' varValue = the value to set this property to.
' strErrMsg = string to append any error message to.

If HasProperty(obj, strPropertyName) Then
obj.Properties(strPropertyName) = varValue
Else
obj.Properties.Append obj.CreateProperty(strPropertyName,
intType, varValue)
End If

SetPropertyDAO = True

ExitHandler:
Exit Function

ErrHandler:
strErrMsg = strErrMsg & obj.name & "." & strPropertyName & " not set
to " & _
varValue & ". Error " & Err.Number & " - " & Err.Description &
vbCrLf
Resume ExitHandler
End Function
Public Function HasProperty(obj As Object, strPropName As String) _
As Boolean
'Purpose: Return true if the object has the property.
Dim varDummy As Variant

On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Function
=====================<End Code<=====================================<
=====================>Text File Input>==============================>
"Employees"~"TitleOfCourtesy"~"Combo Box"~"Value
List"~"Dr.;Mr.;Miss;Mrs.;Ms."~"1"~"1"~"No"~""~"8"~ "Auto"~"No"
"Employees"~"ReportsTo"~"Combo Box"~"Table/Query"~"SELECT
Employees.EmployeeID, [LastName] & ", " & [FirstName] AS Name FROM
Employees ORDER BY Employees.LastName, Employees.FirstName;
"~"1"~"2"~"No"~"0""~"8"~"Auto"~"Yes"
"Order Details"~"ProductID"~"Combo Box"~"Table/Query"~"SELECT
[ProductID], [ProductName] FROM Products ORDER BY [ProductName];
"~"1"~"2"~"No"~"0""~"8"~"Auto"~"Yes"
"Orders"~"CustomerID"~"Combo Box"~"Table/Query"~"SELECT [CustomerID],
[CompanyName] FROM Customers ORDER BY [CompanyName];
"~"1"~"2"~"No"~"0""~"8"~"Auto"~"Yes"
"Orders"~"EmployeeID"~"Combo Box"~"Table/Query"~"SELECT
Employees.EmployeeID, [LastName] & ", " & [FirstName] AS Name FROM
Employees ORDER BY Employees.LastName, Employees.FirstName;
"~"1"~"2"~"No"~"0""~"8"~"Auto"~"Yes"
"Orders"~"ShipVia"~"Combo Box"~"Table/Query"~"SELECT [ShipperID],
[CompanyName] FROM Shippers ORDER BY [CompanyName];
"~"1"~"2"~"No"~"0""~"8"~"Auto"~"Yes"
"Products"~"SupplierID"~"Combo Box"~"Table/Query"~"SELECT [SupplierID],
[CompanyName] FROM Suppliers ORDER BY [CompanyName];
"~"1"~"2"~"No"~"0""~"8"~"Auto"~"Yes"
"Products"~"CategoryID"~"Combo Box"~"Table/Query"~"SELECT [CategoryID],
[CategoryName] FROM Categories ORDER BY [CategoryName];
"~"1"~"2"~"No"~"0""~"8"~"Auto"~"Yes"
=====================<Text File Input<==============================<
--
Regards,

Greg Strong
Mar 30 '06 #1
Share this Question
Share on Google+
2 Replies


P: n/a
"Greg Strong" wrote
Is it possible to change table field lookup
properties in code?


My advice to you is, as you are capable of writing code, you should not be
using Lookup Fields. They are helpful only to novice end users, in datasheet
view. When those novices advance just a little to using queries, we are
going to hear from them in the newsgroups, because those Lookup Fields will
turn out to cause more trouble than they were ever worth to the novice in
his/her datasheet days.

The Boys and Girls in Redmond, in their wisdom, implemented this feature
with violates relational design principles. Violating relational design
principles in what is supposed to be a relational database is A Very Bad
Idea.

Larry Linson
Microsoft Access MVP

Mar 30 '06 #2

P: n/a
On Thu, 30 Mar 2006 05:18:08 GMT, "Larry Linson" <bo*****@localhost.not>
wrote:
The Boys and Girls in Redmond, in their wisdom, implemented this feature
with violates relational design principles. Violating relational design
principles in what is supposed to be a relational database is A Very Bad
Idea.


Ok.

To be honest I was just trying to complete rebuilding NorthWind tables
from scratch. I use a working copy of NW for test purposes. I started
with DDL in code, and had to make some other changes in code that was
not capable in DDL. The last piece was to setup the lookup properties. I
suppose I could just import the tables from a fresh copy of NW. I
believe the lookups would exist this way.

Thanks!

--
Regards,

Greg Strong
Mar 30 '06 #3

This discussion thread is closed

Replies have been disabled for this discussion.