Jump to content
Fórum Script Brasil
  • 0

Listar Aniversariantes do Mes no arquivo .txt


Question

Hello folks,
Estou com um probleminha aqui, gostaria de filtrar os aniversariantes do mes da listbox, e gostaria tambem de ocultar os simbolos "|" da listbox e manter somente na base de dados .txt. Gostaria também de fazer o botao Editar funcionar.
Segue o codigo até o momento e o link para download. Desde já agradeço.
 

Option Explicit





Private Sub UserForm_Initialize()
    With ComboBox1
        .AddItem "01 - Janeiro"
        .AddItem "02 - Fevereiro"
        .AddItem "03 - Março"
        .AddItem "04 - Abril"
        .AddItem "05 - Maio"
        .AddItem "06 - Junho"
        .AddItem "07 - Julho"
        .AddItem "08 - Agosto"
        .AddItem "09 - Setembro"
        .AddItem "10 - Outubro"
        .AddItem "11 - Novembro"
        .AddItem "12 - Dezembro"
    End With

    
    
Call Cria_Pasta
Call PreencheListbox
End Sub

Private Sub CommandButton1_Click()
    If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Then
        MsgBox "Preencha todos os campos", vbInformation, "Atenção"
    Else
        SalvaInfo VBA.Trim(TextBox1.Text) & "|" & VBA.Trim(TextBox2.Text) & "|" & VBA.Trim(TextBox3.Text)
Call Limpar
End If
Call PreencheListbox
End Sub

Sub Limpar()
    TextBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
End Sub

Sub PreencheListbox() 'preencher listbox users
Dim sTemp As String
Dim vrTemp As Variant

    ListBox1.Clear
    On Error Resume Next
    Dim LineofText As Variant
    Dim archivo As Variant
    ' Open the file for Input.
        Open ThisWorkbook.Path & "\REGISTRO\users.txt" For Input As #1
            archivo = ThisWorkbook.Path & "\REGISTRO\users.txt"
        If Dir(archivo) = "" Then
            MsgBox "ARQUIVO não ENCONTRADO. FOI CRIADO UMA PASTA 'REGISTRO' NO MESMO LOCAL DESTE ARQUIVO EXCEL"
    
            Exit Sub
        End If
    Open archivo For Input As #1
    ' Read each line of the text file into a single string
    ' variable.
 
    Do While Not EOF(1)
    'Line Input #1, LineofText
    
        Line Input #1, LineofText
        
    ListBox1.AddItem LineofText
    
        vrTemp = Split(LineofText, "|")
        
        
    
    Loop
    ' Close the file.
    Close #1

End Sub

Private Sub ListBox1_Change()
    TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0)
    'TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 1)
    'TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 2)
End Sub



Sub SalvaInfo(LogMessage As String)

Dim LogFileName As String
Dim ConferePasta As String
Dim FileNum As Integer

    ConferePasta = ThisWorkbook.Path & "\REGISTRO"
    'Definir caminho e nome do arquivo de log onde você deseja salvar
    'O arquivo de log
    
    LogFileName = ConferePasta & "\users.txt"   'nome do arquivo que sera gravado"
    
    FileNum = FreeFile 'Próximo número de arquivo
    Open LogFileName For Append As #FileNum 'Cria o arquivo se ele não existir
    Print #FileNum, LogMessage 'Escrever informações no final do arquivo de texto
    Close #FileNum 'Fechar o arquivo

End Sub

Sub Cria_Pasta()
  Dim ConferePasta As String
        'Atribui caminho do diretório.
     ConferePasta = ThisWorkbook.Path & "\REGISTRO"

       
      'Testa se o diretório existe. Caso não exista, cria-se o mesmo.
        If Dir(ConferePasta, vbDirectory) = "" Then MkDir ConferePasta
             'cancela
        
End Sub

´link para download :

https://drive.google.com/file/d/10t8tDwUi6l9EIpdCRY5a5lMWt0qko9JY/view?usp=sharing

Obirgado

Edited by willianrc
Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Cloud Computing


  • Forum Statistics

    • Total Topics
      148691
    • Total Posts
      644524
×
×
  • Create New...