Option Compare Database
Option Explicit
'***************************************************************************************
' Function : SelArray
' DateTime : 22-06-2005 12:34
' Author : dm
' Purpose : produces an array of values from a multi-select listbox
' Params :
' LstPass : the listbox object whose selections you want
' ColIdx : index of the column in the listbox from which to collect the values. 0-based; default = bound column
' Callback : the name of a public function to apply to each value, eg to add formatting, quote escaping etc
'***************************************************************************************
'
Public Function SelArray(LstPass As ListBox, _
Optional ColIdx As Integer = -1, _
Optional Callback As String) As Variant
Dim arr() As Variant, i As Integer
With LstPass
If ColIdx < 0 Then ColIdx = .BoundColumn - 1
If .ItemsSelected.Count > 0 Then
ReDim arr(.ItemsSelected.Count - 1)
For i = 0 To .ItemsSelected.Count - 1
If Len(Callback) Then
arr(i) = Application.Run(Callback, .Column(ColIdx, .ItemsSelected(i)))
Else
arr(i) = .Column(ColIdx, .ItemsSelected(i))
End If
Next i
SelArray = arr
Else
SelArray = Null
End If
End With
End Function
'***************************************************************************************
' Function : SelString
' DateTime : 22-06-2005 12:34
' Author : dm
' Purpose : produces an string of delimited values from a multi-select listbox
' Params :
' LstPass : the listbox object whose selections you want
' ColIdx : index of the column in the listbox from which to collect the values. 0-based; default = bound column
' Callback : the name of a public function to apply to each value, eg to add formatting, quote escaping etc
' Delim : Delimiter to separate the values. Default is a comma
' Wrap : If True the result will be enclosed in brackets.
'***************************************************************************************
'
Public Function SelString(LstPass As ListBox, _
Optional ColIdx As Integer = -1, _
Optional Callback As String, _
Optional Delim As String = ",", _
Optional Wrap As Boolean = True) As Variant
Dim selVals As Variant
SelString = Null
selVals = SelArray(LstPass, ColIdx, Callback)
If IsArray(selVals) Then
SelString = Join(selVals, Delim)
If Wrap Then
SelString = "(" & SelString & ")"
End If
End If
End Function
Function SQLStr(vIn As Variant, _
Optional blUseNull As Boolean = True, _
Optional blWrap As Boolean = True, _
Optional Delim As String = "'") As String
Dim ret As String
If Not IsNull(vIn) Then
ret = Replace(CStr(vIn), Delim, Delim & Delim)
Else
If blUseNull Then
ret = "NULL"
blWrap = False
End If
End If
If blWrap Then ret = Delim & ret & Delim
SQLStr = ret
End Function