Consulting

Results 1 to 2 of 2

Thread: List (Sort by) Birthday Anniversaries in .txt file

  1. #1

    List (Sort by) Birthday Anniversaries in .txt file

    Hello folks,
    I have a little problem here, I would like to filter out the birthdays of the month of the listbox, and I would like to hide the symbols "|" of the listbox and keep only in the .txt database. I would also like the EDIT, DELETE buttons to work.
    Follow the code so far and the download link. Thank you very much.

    Option Explicit
    
    
    Private Sub UserForm_Initialize()
        With ComboBox1
            .AddItem "01 - January"
            .AddItem "02 - February"
            .AddItem "03 - March"
            .AddItem "04 - April"
            .AddItem "05 - May"
            .AddItem "06 - June"
            .AddItem "07 - July"
            .AddItem "08 - August"
            .AddItem "09 - September"
            .AddItem "10 - October"
            .AddItem "11 - November"
            .AddItem "12 - Dezember"
        End With
    
    
        
    Call Create_Folder
    Call Load_Listbox
    End Sub
    
    
    Private Sub CommandButton1_Click()
        If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Then
            MsgBox "Enter all required fields", vbInformation, "Attention"
        Else
            WriteInfo VBA.Trim(TextBox1.Text) & "|" & VBA.Trim(TextBox2.Text) & "|" & VBA.Trim(TextBox3.Text)
    Call Clean
    End If
    Call Load_Listbox
    End Sub
    
    
    Sub Clean()
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""
    End Sub
    
    
    Sub Load_Listbox() 'Enter all 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 & "\REGISTER\users.txt" For Input As #1
                archivo = ThisWorkbook.Path & "\REGISTER\users.txt"
            If Dir(archivo) = "" Then
                MsgBox "FILE NOT FOUND. A 'REGISTRY' FOLDER HAS NOT BEEN SAME SAME OF THIS EXCEL FILE"
        
                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
    
    
    Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    
    
    TextBox3.MaxLength = 10 '10/10/2017
     Select Case KeyAscii
          Case 8       'Aceita o BACK SPACE
          Case 13: SendKeys "{TAB}"    'Emula o TAB
          Case 48 To 57
             If TextBox3.SelStart = 2 Then TextBox3.SelText = "/"
             If TextBox3.SelStart = 5 Then TextBox3.SelText = "/"
          Case Else: KeyAscii = 0     'Ignore others caracters
       End Select
    End Sub
    
    
    Sub WriteInfo(LogMessage As String)
    
    
    Dim LogFileName As String
    Dim CheckFolder As String
    Dim FileNum As Integer
    
    
        CheckFolder = ThisWorkbook.Path & "\REGISTER"
        'Set path and file name of log where you are? want to save
        'The log file
        
        LogFileName = CheckFolder & "\users.txt"   'filename to be saved'
        
        FileNum = FreeFile 'Next file number
        Open LogFileName For Append As #FileNum 'Create the file if it does not exist
        Print #FileNum, LogMessage 'Write information at the end of the text file
        Close #FileNum 'Close file
    
    
    End Sub
    
    
    Sub Create_Folder()
      Dim CheckFolder As String
            'Assign path to directory.
         CheckFolder = ThisWorkbook.Path & "\REGISTER"
    
    
           
          'Tests whether the directory exists. If it does not exist, the same is created.
            If Dir(CheckFolder, vbDirectory) = "" Then MkDir CheckFolder
                 'cancela
            
    End Sub
    Link download: https://drive.google.com/file/d/1SSf...ew?usp=sharing

    Thanks.

    Enter "EXPRESS" without the quotes in lower case!

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Cross-posted at: https://www.mrexcel.com/forum/excel-...-txt-file.html
    Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •