Este fórum está sendo desativado

[willianrc]

Ola amigos, tentei fazer um codigo para editar um .txt , mas está duplicando na base de dados, alguma ajuda?
Alguma ajuda também para fazer funcionar os botões EXCLUIR e FILTRAR ?

Código: Selecionar todos

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
Dim LineofText As Variant
Dim archivo As Variant

ListBox1.Clear
ListBox1.ColumnCount = 3
On Error Resume Next
' 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 NAO ENCONTRADO. FOI CRIADO UMA PASTA 'REGISTRO' NO MESMO LOCAL DESTE ARQUIVO EXCEL"
Exit Sub
End If

Open archivo For Input As #1
Do While Not EOF(1)
    Line Input #1, LineofText
    vrTemp = Split(LineofText, "|")
    ListBox1.AddItem vrTemp(0)
    ListBox1.List(ListBox1.ListCount - 1, 1) = vrTemp(1)
    ListBox1.List(ListBox1.ListCount - 1, 2) = vrTemp(2)
Loop
' Close the file.
Close #1
End Sub

Private Sub ListBox1_Change()
    CommandButton1.Enabled = False
    TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0)
    TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 1)
    TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 2)
    Call TextBox4_AfterUpdate
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

Private Sub CommandButton3_Click()
    Call TextFile_FindReplace
    Call Limpar
    
    Unload Me
    UserForm1.Show
End Sub

Private Sub TextBox1_Change()
    Call TextBox4_AfterUpdate
End Sub
Private Sub TextBox2_Change()
    Call TextBox4_AfterUpdate
End Sub
Private Sub TextBox3_Change()
    Call TextBox4_AfterUpdate
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
Private Sub TextBox4_AfterUpdate()
    TextBox4.Text = ""
    TextBox4.Text = TextBox1.Text & "|" & TextBox2.Text & "|" & TextBox3.Text & "|"
End Sub

Sub TextFile_FindReplace()
'OBJETIVO: modificar o conte?do de um arquivo de texto usando localizar / substituir
'SOURCE: www.TheSpreadsheetGuru.com

Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String

'Caminho de arquivo do arquivo de texto
  FilePath = ThisWorkbook.Path & "\REGISTRO\users.txt"

'Determina o pr?ximo n?mero de arquivo dispon?vel para uso pela fun??o FileOpen
  TextFile = FreeFile

' Abre o arquivo de texto em um Estado de Leitura
  Open FilePath For Input As TextFile

'Armazena o conte?do do arquivo dentro de uma vari?vel
  FileContent = Input(LOF(TextFile), TextFile)

'fecha Arquivo de Texto
  Close TextFile
  
' Localizar / Substituir
  FileContent = Replace(FileContent, TextBox1.Text, TextBox4.Text)

'Determinar o pr?ximo n?mero de arquivo dispon?vel para uso pela fun??o FileOpen
  TextFile = FreeFile

' Abra o arquivo de texto em um estado de grava??o
  Open FilePath For Output As TextFile
  
'Gravar novos dados de texto no arquivo
  Print #TextFile, FileContent

' Fechar arquivo de texto
  Close TextFile

End Sub

Segue em anexo.

[babdallas]

Vi meio por cima seu código. Para adiantar a análise, poderia dizer qual(is) rotina(s) você edita o txt?