I have a Form in which following options are available to get the e-mail addresses of the respective records, based on the following code:
Status
Group
Item
Country
City
-------------------------------------------------------------------------------------------------------
Dim MyDatabase As Database
Dim MyQueryDef As QueryDef
Dim where As Variant
Set MyDatabase = CurrentDb()
If ObjectExists("Queries", "qryDynamic_QBF") = True Then
MyDatabase.QueryDefs.Delete "qryDynamic_QBF"
MyDatabase.QueryDefs.Refresh
End If
where = Null
where = where & " AND [Status]= '" + Me![DataBank Status] + "'"
where = where & " AND [Country]= '" + Me![DataBank Country] + "'"
where = where & " AND [City]= '" + Me![DataBank City] + "'"
where = where & " AND [Group]= '" + Me![DataBank Group] + "'"
where = where & " AND [Item]= '" + Me![DataBank Item] + "'"
If left(Me![DataBank City], 1) = "*" Or Right(Me![DataBank City], 1) = "*" Then
where = where & " AND [City] like '" + Me![DataBank City] + "'"
Else
where = where & " AND [City] = '" + Me![DataBank City] + "'"
End If
Set MyQueryDef = MyDatabase.CreateQueryDef("qryDynamic_QBF", _
"Select * from Find1 " & (" where " + Mid(where, 6) & ";"))
DoCmd.OpenForm "Email"
DoCmd.Close acForm, "frmDynamicQBF", acSaveNo
End Sub
----------------------------------------------------------------------------------------------------
& at the time of opening Form “Email”, which has following code, shows Runtime error in the following line of Form_Current.
iListItemsCount = iListItemsCount + 1
Form E Mail has created to retrieve the selected items in a multiple selection List Box as a comma-delimited string. For which, you may refer following link
http://support.microsoft.com/kb/827423
Now, you can understand what is the problem.
---------------------------------------------------------------------------------------------------
Private Sub Form_Current()
Dim oItem As Variant
Dim bFound As Boolean
Dim sTemp As String
Dim sValue As String
Dim sChar As String
Dim iCount As Integer
Dim iListItemsCount As Integer
sTemp = Nz(Me!mySelections.Value, " ")
iListItemsCount = 0
bFound = False
iCount = 0
Call clearListBox
For iCount = 1 To Len(sTemp) + 1
sChar = Mid(sTemp, iCount, 1)
If StrComp(sChar, "") = 0 Or iCount = Len(sTemp) + 1 Then
bFound = False
Do
If StrComp(Trim(Me!Nameslist.ItemData(iListItemsCount )), Trim(sValue)) = 0 Then
Me!Nameslist.Selected(iListItemsCount) = True
bFound = True
End If
iListItemsCount = iListItemsCount + 1
Loop Until bFound = True Or iListItemsCount = Me!Nameslist.ListCount
sValue = ""
Else
sValue = sValue & sChar
End If
Next iCount
End Sub
Private Sub clearListBox()
Dim iCount As Integer
For iCount = 0 To Me!Nameslist.ListCount
Me!Nameslist.Selected(iCount) = False
Next iCount
End Sub
Private Sub OK_Click()
Dim StText As String
Dim stDocName As String
stDocName = "Empty_Report"
StText = "We are interested in buying the following items for Shipment" & Chr$(13) & _
Chr(13) & "1." & Chr$(13) & _
Chr(13) & " a) Size of Briquets/Bales :" & Chr(13) & _
" b) Origin :" & Chr(13) & _
" c) How much Quantity you are going to load in 20'/40' container: " & Chr(13) & _
Chr(13) & "Awaiting your reply." & Chr$(13) & _
Chr(13) & "Thanks," & Chr$(13) & _
Chr(13) & "Manager - Purchase" & Chr$(13) & _
'DoCmd.SendObject acSendNoObject, stDocName, acFormatXLS, Me.mySelections, , , "Enquiry", StText, True
End Sub
Private Sub testmultiselect_Click()
Dim oItem As Variant
Dim sTemp As String
Dim iCount As Integer
iCount = 0
If Me!Nameslist.ItemsSelected.Count <> 0 Then
For Each oItem In Me!Nameslist.ItemsSelected
If iCount = 0 Then
sTemp = sTemp & Me!Nameslist.ItemData(oItem)
iCount = iCount + 1
Else
sTemp = sTemp & "" & Me!Nameslist.ItemData(oItem)
iCount = iCount + 1
End If
Next oItem
Else
MsgBox "Nothing was selected from the list", vbInformation
Exit Sub 'Nothing was selected
End If
Me!mySelections.Value = sTemp
End Sub
Private Sub clrList_Click()
Call clearListBox
Me!mySelections.Value = Null
End Sub
----------------------------------------------------------------------------------------------------------
31
