BUSCA DINAMICA 02

Dim rsTemp As Recordset
Dim sCont As Integer [ô]Contador de caracter
Dim tCont As Integer [ô]Armazena o total de caracter na entrada
Dim sText As String [ô]Armazena o texto de entrada
Dim rText As String [ô]Armazena o resultado do split

Set rsTemp = New ADODB.Recordset
    rsTemp.Open [Ô]SELECT * FROM DadosCab[Ô], ConexaoLM, adOpenKeyset, adLockPessimistic
    sCont = 1
    tCont = 0
    With rsTemp
        If .BOF = True And .EOF = True Then Exit Sub
        Do Until .EOF = True
            tCont = Len(!Desenho)
            If tCont = 13 Then
                Do Until sCont > tCont
                    rText = Mid$(!Desenho, sCont, 1)
                    If rText <> [Ô]-[Ô] Then
                        sText = sText & rText
                    End If
                    sCont = sCont + 1
                Loop
            End If
            If TxtBusca.Text = sText Then
                [ô]Rotina de Preencher o grid
            Else
                [ô]Menssagem de Erro
            End If
            
            .MoveNext
        Loop
    End With

Citação:

IRENKO escreveu:
Bom, consegui uma alternativa, vai ficar bem grande mas preciso de ajuda. O codigo abaixo me retorna o seguinte:

Se digito no TextBusca 0679023481 vai formatar para 0679-02-348-1 e buscar corretamente. Agora lá no banco pode estra assim como exemplo:

0178-2-82-1 ou 01782821

eu teria que contar sempre a quant de caracteres e formatar colocando o (-). Precisaria de uma função que faça isso.

pode extir um texto com 11 caracteres = 0178-2-82-1, neste caso não precisaria formatação
se fosse com 08 caracteres 01782821, ai formataria para 0178-2-82-1

se fosse com 13 caracteres 0679-02-580-1, neste caso não precisaria formatação.
se fosse com 10 caracteres 0679025811, ai formataria para 0679-02-580-1.




Dim PrimeiraPart As String
Dim SegundaPart As String
Dim Data As String
Dim Result As String
Dim strSQL As String
Data = TxtBusca.text
If Len(TxtBusca.text) = 10 Then
PrimeiraPart = Mid$(Data, 1, 4)
SegundaPart = Mid$(Data, 5, 2)
TerceiraPart = Mid$(Data, 7, 3)
QuartaPart = Mid$(Data, 10, 1)
End If
Result = PrimeiraPart & [Ô]-[Ô] & SegundaPart & [Ô]-[Ô] & TerceiraPart & [Ô]-[Ô] & QuartaPart
.Source = [Ô]SELECT Desenho,LM_2 AS Lista FROM DadosCab WHERE Desenho like [ô]%[Ô] & Result & [Ô]%[ô] ORDER BY LM_2[Ô]

 
Public Function Format_Nr_Desenho(sValor As String) As String
Dim sConta As Integer
Dim tTexto, rTexto As String

If Len(sValor) = 13 Then Format_Nr_Desenho = sValor: Exit Function

If Len(sValor) = 10 Then   [ô]Verifica se foi informado 10 caracteres numericos
    sConta = 1
    
    Do Until sConta > Len(sValor)
        tTexto = Mid$(sValor, sConta, 1)
        If sConta = 5 Or sConta = 7 Or sConta = 10 Then
            rTexto = rTexto & [Ô]-[Ô] & tTexto
        Else
            rTexto = rTexto & tTexto
        End If
        sConta = sConta + 1
    Loop
ElseIf Len(sValor) = 8 Then [ô]Verifica se foi informado 8 caracteres numericos
    sConta = 1
    
    Do Until sConta > Len(sValor)
        tTexto = Mid$(sValor, sConta, 1)
        If sConta = 5 Or sConta = 6 Or sConta = 8 Then
            rTexto = rTexto & [Ô]-[Ô] & tTexto
        Else
            rTexto = rTexto & tTexto
        End If
        sConta = sConta + 1
    Loop
Else  [ô]Se foi digitado caracter numérico que seja 8 ou 10 informa neste erro
    MsgBox [Ô]O número informado não corresponde ao padrão do sistema.[Ô] & vbNewLine & _
           [Ô]Você de deve informar 8 ou 10 números para a pesquisa seja[Ô] & vbNewLine & _
           [Ô]executada corretamente.[Ô], vbCritical, [Ô]Erro na Formatação[Ô]
        
End If

Format_Nr_Desenho = rTexto

End Function

Citação:

No campo esta assim: 0679-02-348-1

se digito: 0679023481 cai aqui:

MsgBox [Ô]Lista de Material não cadastrada ou já liberada![Ô], vbCritical, [Ô]Erro de pesquisa[Ô]

Fiz o Debug.Print e a formatação esta posicionando aqui: Formato10(0) = [Ô]@@@@\-@\-@@@\-@@[Ô]

A varialvel DadoFormatado esta assumindo a formatação, Formato10(0) = [Ô]@@@@\-@\-@@@\-@@[Ô] ou seja o Laço só esta pegando o primeiro.

Acho que vou deixar isso pra lá.

Dim Dado As String
Dim Formato10(4) As String
Dim Formato8(4) As String
Dim DadoFormatado(4) As String
Dim DadoSemFormato As String
Dim Source As String
Dim i As Integer

Formato8(0) = [Ô]@@@@\-@\-@@\-@[Ô]
Formato8(1) = [Ô]@@@@\.@\.@@\.@[Ô]

Formato10(0) = [Ô]@@@@\-@\-@@@\-@@[Ô]
Formato10(1) = [Ô]@@@@\-@@\-@@@\-@[Ô]
Formato10(2) = [Ô]@@@@\.@\.@@@\.@@[Ô]
Formato10(3) = [Ô]@@@@\.@@\.@@@\.@[Ô]

Dado = Trim(txtBusca.Text)

If Len(Dado) = 8 Then
    For i = 0 To UBound(Formato10) - 1
        If Formato8(i) <> [Ô][Ô] Then
            DadoFormatado(i) = Format(Dado, Formato8(i))
        End If
    Next
ElseIf Len(Dado) = 10 Then
    For i = 0 To UBound(Formato10) - 1
        If Formato10(i) <> [Ô][Ô] Then
            DadoFormatado(i) = Format(Dado, Formato10(i))
        End If
    Next
End If

DadoSemFormato = Replace(Replace(Dado, [Ô]-[Ô], [Ô][Ô]), [Ô].[Ô], [Ô][Ô])

If Len(Dado) = 8 Or Len(Dado) = 10 Then
    Source = [Ô]SELECT Desenho,LM_2 AS Lista FROM DadosCab WHERE Desenho = [ô][Ô] & DadoSemFormato & [Ô][ô][Ô]
    For i = 0 To UBound(DadoFormatado) - 1
        If DadoFormatado(i) <> [Ô][Ô] Then
            Source = Source & [Ô] OR Desenho = [ô][Ô] & DadoFormatado(i) & [Ô][ô][Ô]
        End If
    Next
    Source = Source & [Ô] ORDER BY LM_2[Ô]
End If