[Resolvido]Encontrar data em uma textbox

Olá,


Preciso de uma ajuda.

Tenho uma caixa de texto (txtBox) que terá textos aleatórios. Nunca a posição das palavras vai ser igual.

Nessa txtBox, em um form, aleatoriamente terei datas e horários, que também não podem ser previstos. Por exemplo, entre 01/01/2000 e 31/12/2050

Preciso de uma função que encontre o padrão de datas (dd/mm/aaaa) na textbox (qualquer data), e o padrão de horário (hh:mm), e retorne isso em 2 caixas de texto separadas no form: txtDia e txtHora

É possível?

Estou na fase de pesquisa e descobertas.

Ao ler sua questão me lembrei de um código que vi do Mestre JPaulo.

Pode não ser o caminho mais fácil, mas foi o mais lógico para mim no momento.

A ideia simples.

1.Pega-se o Texto (txt01) dismembra palavra por palavra.
2. Depois passa cada palavra no teste para ver se é data.
3. Se for data entra em outro teste para determinar se é formato de data ou de horário
4. Colocar a data e o horário em txtData e txtHora

Testei e funcionou. Porém algum colega pode ter uma visão onde seja mais simples.

Coloquei em uma sub ao clicar um botão, mas depois você pode brincar da forma que desejar.

Abraço

Luizmilk

Código:

Dim VarData As Date
Dim VarHora As Date
Dim strBox As String

strBox = Me.txt01
'=====================

Dim strArray() As String
Dim strParteInteira As Integer
Dim i As Integer

On Error GoTo Fim

    strBox = Replace(strBox, ".", "") '==== Tira pontos pois se eles estiverem junto com a data ou com as horas, não será detectado
    strBox = Replace(strBox, ",", "") '==== Tira pontos pois se eles estiverem junto com a data ou com as horas, não será detectado
    '==== Se houver outros sinais que atrapalhem, acrescente

    strArray = Split(strBox, " ") '==== Separa as palavras e coloca em uma Matriz
    
    strParteInteira = UBound(strArray) + 1 '==== Determina quantas palavras tem a frase
    
    If strParteInteira = 0 Then '==== Se não há palavra alguma, devolve a string da mesma forma como veio
        txt01 = strFrase
        Exit Sub
    End If
    
    For i = 1 To strParteInteira '==== Vai pegar cada palavra e montar novamente, porém uma abaixo da outra
        If IsDate(Format(Trim(strArray(i - 1)), "dd/mm/yyyy")) Then
            If Trim(strArray(i - 1)) Like "##:##" Then VarHora = Trim(strArray(i - 1))
            If Trim(strArray(i - 1)) Like "##/##/####" Then VarData = Trim(strArray(i - 1))
        End If
    Next

'=====================
txtData = VarData
txtHora = VarHora


Finalizar:
Exit Sub

Fim:
MsgBox Err & " - " & Error$, vbExclamation, "Pega Data"
Resume Finalizar

Vou testar aqui e te falo!! Obrigada!

Fiz esses ajustes, mas funcionou!

Código:


Public Sub testeData()

Dim VarData As Date
Dim VarHora As Date
Dim strBox As String
Dim strFrase As String


Dim txtData As String
Dim txtHora As String

strBox = forms!nomedoform![campo]
'=====================

Dim strArray() As String
Dim strParteInteira As Integer
Dim i As Integer

'On Error GoTo Fim

    strBox = Replace(strBox, ".", "") '==== Tira pontos pois se eles estiverem junto com a data ou com as horas, não será detectado
    strBox = Replace(strBox, ",", "") '==== Tira pontos pois se eles estiverem junto com a data ou com as horas, não será detectado
    '==== Se houver outros sinais que atrapalhem, acrescente

    strArray = Split(strBox, " ") '==== Separa as palavras e coloca em uma Matriz
   
    strParteInteira = UBound(strArray) + 1 '==== Determina quantas palavras tem a frase
   
    If strParteInteira = 0 Then '==== Se não há palavra alguma, devolve a string da mesma forma como veio
        strBox = strFrase
        Exit Sub
    End If
   
    For i = 1 To strParteInteira '==== Vai pegar cada palavra e montar novamente, porém uma abaixo da outra
        If IsDate(Format(Trim(strArray(i - 1)), "dd/mm/yyyy")) Then
            If Trim(strArray(i - 1)) Like "##:##" Then VarHora = Trim(strArray(i - 1))
            If Trim(strArray(i - 1)) Like "##/##/####" Then VarData = Trim(strArray(i - 1))
        End If
    Next

'=====================
txtData = VarData
txtHora = VarHora

End Sub