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 funcionar os botoes EDITAR E EXCLUIR.
Segue o codigo até o momento e o link para download. Desde ja 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 NAO 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
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
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
Você pretende utilizar o .txt como banco de dados? Não recomendo.
Apesar de factível, e de longe, no meu ponto de vista, o mais fraco e inseguro das possibilidades.
Nada errado/contra os seus motivos;
porem utilizar um txt para armazenar: extrair / filtrar / excluir registros, requer um grande cuidado/esforço na programação,para garantir a integridade doas informações, que vai demandar um tempo (pelo menos para mim) que não disponho.
Vamos ver se algum colega possa lhe auxiliar.
Sub TextFile_FindReplace()
'PURPOSE: Modify Contents of a text file using Find/Replace
'SOURCE: www.TheSpreadsheetGuru.com
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
'File Path of Text File
FilePath = "C:\Users\chris\Desktop\MyFile.txt"
'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile
'Open the text file in a Read State
Open FilePath For Input As TextFile
'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)
'Clost Text File
Close TextFile
'Find/Replace
FileContent = Replace(FileContent, "Goodbye", "Cheers")
'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile
'Open the text file in a Write State
Open FilePath For Output As TextFile
'Write New Text data to file
Print #TextFile, FileContent
'Close Text File
Close TextFile
End Sub
Consegui fazer alterar , so que na base de dados ficou uma bagunça, alguma ajuda?
Esta duplicando os dados desorganizando a integridade da base de dados.