Passar uma listagem para o Operador "In" num recordset via VBA

Prezados, boa noite. Estou com a seguinte dúvida e gostaria da ajuda do grupo.

Tenho um recordset, no qual aplico vários critérios de filtros. Porém gostaria de passar como critérios de filtro uma lista selecionada pelo usuário. Nesta lista eu tenho 19 opções a serem escolhidas, tanto isoladamente quanto de forma concomitante. O recordset utilizado é o seguinte: set rstRetorno = Db.OpenRecordset("Select tb_Dados_NF.* from tb_Dados_NF where (((tb_Dados_NF.ID_MEIO) In ('03';'04')"));") . Assim, o objetivo é o usuário selecionar em um formulário quais serão os critérios a serem aplicados no "Operador In", indo do 01 ao 19.

Desde já agradecido pela atenção dispensada.

Olá Salomão,

Copie e cole o código abaixo:

Código:



Public Sub CarregaDados()
On Error GoTo trata_erro
Dim i              As Integer
Dim sSQL            As String
Dim rstRetorno      As DAO.Recordset
Dim vDados          As String


    vDados = Empty
   
    'substitua NOME_DA_SUA_LISTA pela sua lista do sistema
    With NOME_DA_SUA_LISTA
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                vDados = vDados & "'" & .Column(0, i) & "',"
            End If
        Next i
    End With
    vDados = Mid(vDados, 1, Len(vDados) - 1)
   
    sSQL = "SELECT * FROM tb_Dados_NF WHERE ID_MEIO In (" & vDados & ")"
    Set rstRetorno = CurrentDb.OpenRecordset(sSQL)
   
   
    If Not rstRetorno.EOF Then
    '-- informe aqui a rotina desejada
    End If
   
    rstRetorno.Close
    Set rstRetorno = Nothing
   
   
    Exit Sub

trata_erro:
    MsgBox "Erro gerado: " & Err.Number & " - " & Err.Description & "", vbCritical, "Erro"
    Exit Sub

End Sub





Obs.: estou pressupondo que os códigos estejam na coluna ZERO da sua listbox:

.Column(0, i)

Onde 0 é a coluna e i é a linha (quando for selecionada)

Do contrário, substitua pela coluna que contem o valor desejado.

Não se esqueça de substituir NOME_DA_SUA_LISTA pelo nome da listbox utilizada na rotina.

Acredito que funcione.
Qualquer problema mande aqui.

É isso!!

[]'s


FIM

Obrigado, mesmo, Alexandre. Vou testar e retorno.