B
bymarce
I'm making a form for generating records to represent a matrix of
experimental results. So if I have three samples for which I need to test
melting point and boiling point we need 6 records. My users don't want to
type in every record.
The form has two multiselect list boxes and a command button. The first
list box contains the sample ID numbers and the second contains
Property/Method combinations. The sample ID is a compound primary key from
the sample catalog table. The property/method combinations come from
Property and Method tables which are joined in a many to many relationship
through a join table. The command button runs VBA code I wrote to generate
all combinations of the sample ID and Property/Method. If I select only one
sample ID and one Property/Method, the code runs fine. If I select more than
one sample ID Access quits responding. How do I fix this? I hope this is
clear. Thanks for the help.
Marcie
Private Sub cmdPreview_Click()
If Me.lstMLO.ListCount = 0 Then
MsgBox "You must select at least 1 MLO Number."
Exit Sub
End If
'Build Where string to generate data matrix of records.
Dim strWhere As String, strMLO As String
Dim strPrefix As String, strYear As String, strID As String, varItem As
Variant, strQ As String
strQ = """"
With Me.lstMLO
For Each varItem In .ItemsSelected
strPrefix = Left(.ItemData(varItem), 3)
strYear = Left(.ItemData(varItem), 8)
strYear = Right(strYear, 4)
strID = Right(.ItemData(varItem), 4)
strMLO = strMLO & "((MLOBOOK.CatalogPrefix Like " & strQ
& strPrefix & strQ & _
") AND (MLOBOOK.CatalogYear = " &
strYear & _
") AND (MLOBOOK.CatalogID = " &
strID & ")) OR "
Next varItem
Dim lenstrMLO As Long
lenstrMLO = Len(strMLO) - 4
If lenstrMLO > 0 Then
strMLO = Left(strMLO, lenstrMLO)
strMLO = strMLO & " AND "
End If
End With
Dim lenSplit As Long, strTestMethod As String, strProperty As String,
strPropertyMethod As String
With Me.lstPropertyMethod
For Each varItem In .ItemsSelected
strPropertyMethod = .ItemData(varItem)
lenSplit = InStr(1, strPropertyMethod, "/")
strProperty = Left(strPropertyMethod, lenSplit - 1)
strMethod = Right(strPropertyMethod, Len(strPropertyMethod)
- lenSplit)
strWhere = strMLO & "(((Properties.Property) = " & strQ &
strProperty & strQ & _
") AND ((TestMethods.Method)=" & strQ &
strMethod & strQ & "))"
Debug.Print strWhere
If Len(strWhere) <= 0 Then
MsgBox "You have not selected anything. Please try
again."
Else
Dim sqlPreview As String
sqlPreview = "INSERT INTO tblDataTemp ( CatalogPrefix,
CatalogYear, CatalogID, Property, TestMethod, TestAssignedTime ) " & _
"SELECT MLOBOOK.CatalogPrefix,
MLOBOOK.CatalogYear, MLOBOOK.CatalogID, Properties.Property,
TestMethods.Method, Format(Now()," & strQ & "hhnn" & strQ & ") AS
TestAssignedTime " & _
"FROM Properties, TestMethods, MLOBOOK " & _
"WHERE " & strWhere & ";"
Dim dbPreview As DAO.Database
Set dbPreview = DBEngine(0)(0)
dbPreview.Execute sqlPreview
End If
Next varItem
End With
End Sub
experimental results. So if I have three samples for which I need to test
melting point and boiling point we need 6 records. My users don't want to
type in every record.
The form has two multiselect list boxes and a command button. The first
list box contains the sample ID numbers and the second contains
Property/Method combinations. The sample ID is a compound primary key from
the sample catalog table. The property/method combinations come from
Property and Method tables which are joined in a many to many relationship
through a join table. The command button runs VBA code I wrote to generate
all combinations of the sample ID and Property/Method. If I select only one
sample ID and one Property/Method, the code runs fine. If I select more than
one sample ID Access quits responding. How do I fix this? I hope this is
clear. Thanks for the help.
Marcie
Private Sub cmdPreview_Click()
If Me.lstMLO.ListCount = 0 Then
MsgBox "You must select at least 1 MLO Number."
Exit Sub
End If
'Build Where string to generate data matrix of records.
Dim strWhere As String, strMLO As String
Dim strPrefix As String, strYear As String, strID As String, varItem As
Variant, strQ As String
strQ = """"
With Me.lstMLO
For Each varItem In .ItemsSelected
strPrefix = Left(.ItemData(varItem), 3)
strYear = Left(.ItemData(varItem), 8)
strYear = Right(strYear, 4)
strID = Right(.ItemData(varItem), 4)
strMLO = strMLO & "((MLOBOOK.CatalogPrefix Like " & strQ
& strPrefix & strQ & _
") AND (MLOBOOK.CatalogYear = " &
strYear & _
") AND (MLOBOOK.CatalogID = " &
strID & ")) OR "
Next varItem
Dim lenstrMLO As Long
lenstrMLO = Len(strMLO) - 4
If lenstrMLO > 0 Then
strMLO = Left(strMLO, lenstrMLO)
strMLO = strMLO & " AND "
End If
End With
Dim lenSplit As Long, strTestMethod As String, strProperty As String,
strPropertyMethod As String
With Me.lstPropertyMethod
For Each varItem In .ItemsSelected
strPropertyMethod = .ItemData(varItem)
lenSplit = InStr(1, strPropertyMethod, "/")
strProperty = Left(strPropertyMethod, lenSplit - 1)
strMethod = Right(strPropertyMethod, Len(strPropertyMethod)
- lenSplit)
strWhere = strMLO & "(((Properties.Property) = " & strQ &
strProperty & strQ & _
") AND ((TestMethods.Method)=" & strQ &
strMethod & strQ & "))"
Debug.Print strWhere
If Len(strWhere) <= 0 Then
MsgBox "You have not selected anything. Please try
again."
Else
Dim sqlPreview As String
sqlPreview = "INSERT INTO tblDataTemp ( CatalogPrefix,
CatalogYear, CatalogID, Property, TestMethod, TestAssignedTime ) " & _
"SELECT MLOBOOK.CatalogPrefix,
MLOBOOK.CatalogYear, MLOBOOK.CatalogID, Properties.Property,
TestMethods.Method, Format(Now()," & strQ & "hhnn" & strQ & ") AS
TestAssignedTime " & _
"FROM Properties, TestMethods, MLOBOOK " & _
"WHERE " & strWhere & ";"
Dim dbPreview As DAO.Database
Set dbPreview = DBEngine(0)(0)
dbPreview.Execute sqlPreview
End If
Next varItem
End With
End Sub