Adding multiselect listbox items as a filter in sql statement (1 Viewer)

Private Sub cmdExport_Click()
 Dim strPath As String
 Dim strName As String
 Dim strFull As String
 Dim intCount As Integer
 Dim NewName As String
 Dim strsql As String
 Dim i As Integer
 Dim a As String
 a = ""
' Fetch multiple campaign types 

 For i = 0 To Me.cboType.ListCount - 1
   If Me.cboType.Selected(i) = True Then
      a = a & "Type=" & Me.cboType.ItemData(i) & " " & "or "
   End If
 Next i

' How to add multiple campaign types filter in the sql below. We will add filter in 'Type' field???"

 strsql = "SELECT tbl_LM_Lead_Mas_Details.*, tbl_LM_Lead_Mas_Customer.*, tbl_LM_Lead_Ref_Campaign.Type FROM (tbl_LM_Lead_Mas_Customer INNER JOIN (tbl_LM_Lead_Mas_Details INNER JOIN tbl_LM_Lead_Ref_CustomerLead ON tbl_LM_Lead_Mas_Details.LeadId = tbl_LM_Lead_Ref_CustomerLead.Leadid) ON tbl_LM_Lead_Mas_Customer.CustomerNo = tbl_LM_Lead_Ref_CustomerLead.CustomerNo) INNER JOIN tbl_LM_Lead_Ref_Campaign ON tbl_LM_Lead_Mas_Details.CampaignId = tbl_LM_Lead_Ref_Campaign.CampaignId WHERE (((tbl_LM_Lead_Mas_Details.LeadStatusId)=1) AND ((tbl_LM_Lead_Mas_Details.AcceptedBy) Is Null));"

 strName = "LM_DailyExport"

   
 NewName = strName

 strFull = CurrentProject.Path & "\" & NewName & ".txt"
  
        
 DoCmd.TransferText acExportDelim, , strsql, FileName:=strFull, hasfieldnames:=False
 MsgBox "Leads exported for " & Me.cboType.Column(1), vbInformation + vbOKOnly, "Export Completed"
 Me.cmdExport.Visible = False
 Me.cmdLeadExportClick.Visible = True
 Me.cboType = ""
End Sub

Public Function getLBX(Lbx As ListBox, Optional varColumn As Integer = 0, Optional DeLim As String = ",", Optional TrimEnd As Integer = 1, Optional StringDataType As Boolean = False) As String
'arguments
'Lbx is the name of the listbox
'varColumn is the column number to return
'Delim is the delimiter to use between values
'TrimEnd is the number of spaces to trim off the end of the returned string
'StringDataType is true for strings and false for numerical

    Dim strList As String
    Dim varSelected As Variant

    If Lbx.ItemsSelected.Count = 0 Then
        'MsgBox "You haven't selected anything"
    Else
        For Each varSelected In Lbx.ItemsSelected
        If StringDataType Then
        'its a text string
         strList = strList & Chr(34) & Lbx.Column(varColumn, varSelected) & Chr(34) & DeLim
        Else
        'its numeric
            strList = strList & Lbx.Column(varColumn, varSelected) & DeLim
                End If
        Next varSelected
        strList = Left$(strList, Len(strList) - TrimEnd)
        'MsgBox "You selected the following items:" & vbCrLf & strList
    End If

    getLBX = strList

End Function

Where CampaignType in (" & getLbx(me.MyListBoxName) & ")"

strsql = "select * from qry_LM_Daily_Extract_New_1 where [Type] in (" & strlist & ")"

[COLOR="Red"]DoCmd.TransferText acExportDelim, , strsql, FileName:=strFull, hasfieldnames:=False[/COLOR]

    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim strQD As String
    Dim strPath As String
    Dim strName As String
    Dim strFull As String
    Dim strList As String
    
    strList = getLBX(Me.List2, 0) 'get the delimited list from the listbox

    strName = "TestDoc.txt"
    strPath = CurrentProject.Path & "\"
    strFull = strPath & strName

    Set db = CurrentDb

    strQD = "select * from qry_LM_Daily_Extract_New_1 where [Type] in (" & strList & ")"  ' your Sql string
        
    With db.CreateQueryDef("QryTest", strQD) ' create a temporary query named QryTest
    
        DoCmd.TransferText acExportDelim, , "QryTest", FileName:=strFull, hasfieldnames:=False  'execute the transfer text

    End With

    db.QueryDefs.Delete "QryTest"   'Delete the temporary query

    Set qdf = Nothing
    Set db = Nothing