Jump to content
Fórum Script Brasil
  • 0

Agenda em TXT


frata

Question

Prezados amigo:

Procurei e encontrei, uma agenda ótima e simples que salva os dados

em TXT e com todos os recursos de alterar buscar, etc.

Abaixo segue o link.

Gostaria de saber como colocar mais ítens nessa agenda, ou seja,

melhorá-la para ficar mais completa, com e-mail endereço, celular,

local para observações,etc.

Grande abraço a todos. Frata.

http://www.vbmania.com.br/pages/index.php?...&varID=3248

Link to post
Share on other sites

3 answers to this question

Recommended Posts

  • 0

Bem, voltando à agenda TXT, que é o que realmente importa;

eu modifiquei o código, como segue abaixo, e já entendi como colocar

outros dados na agenda, como e-mail, endereço, etc.

Observei que ele salva no arquivo txt, porém não sei como fazer

para carregar os dados no formulário e para modificá-los.

Obrigado mais uma vez antecipadamente aos amigos

deste Forum. Frata

Sub Solicita_Novo()
On Error GoTo erro
    frmCad.Caption = "Adicionando novo cadastro..."
    frmCad.Show 1, frmCli
Exit Sub
erro:
MsgBox "Erro ao solicitar novo registro! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Atualiza_Acoes()
On Error GoTo erro
With frmCli.tbr
    If Dir(Dados) = "" Then
        .Buttons(3).Enabled = False
        .Buttons(5).Enabled = False
        .Buttons(7).Enabled = False
        Else
        .Buttons(3).Enabled = True
        .Buttons(5).Enabled = True
        .Buttons(7).Enabled = True
    End If
    Me.Mostrar
    If frmCli.lst.ListItems.Count < 1 Then
        .Buttons(3).Enabled = False
        .Buttons(5).Enabled = False
        .Buttons(7).Enabled = False
        Else
        .Buttons(3).Enabled = True
        .Buttons(5).Enabled = True
        .Buttons(7).Enabled = True
    End If
End With
Exit Sub
erro:
MsgBox "Erro ao atualizar ações! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Gravar()
On Error GoTo erro
    Open Dados For Append As 1
        With frmCad
            Print #1, .txtNome.Text & "//" & .txtTel.Text; "//" & .txtEmail.Text
        End With
    Close #1
    Unload frmCad
    Me.Atualiza_Acoes
    MsgBox "Registro gravado com sucesso!", vbInformation, "Informação"
Exit Sub
erro:
MsgBox "Erro ao gravar registro! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Alterar()
On Error GoTo erro
    With frmCli
    
    
        .lst.SelectedItem = frmCad.txtNome.Text
        .lst.SelectedItem = frmCad.txtEmail.Text
        .lst.SelectedItem.SubItems(1) = frmCad.txtTel.Text
        
        
        
        Unload frmCad
        
        .pbr.Max = .lst.ListItems.Count
        .pbr.Value = 0
        
        Open Dados For Output As 1
        
            Do While .pbr.Value < .pbr.Max
                .pbr.Value = .pbr.Value + 1
                .lst.ListItems.Item(.pbr.Value).Selected = True
                Print #1, .lst.SelectedItem.Text & "//" & .lst.SelectedItem.SubItems(1)
            Loop
        Close #1
        .pbr.Value = 0
        MsgBox "Registro alterado com sucesso!", vbInformation, "Informação"
    End With
Exit Sub
erro:
MsgBox "Erro ao alterar registro! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Excluir()
On Error GoTo erro
    With frmCli
    
                
        If MsgBox("Deseja realmente excluir o registro selecionado?", 4 + 32, "Exclusão") <> 6 Then Exit Sub
        
        .lst.ListItems.Remove (.lst.SelectedItem.Index)
        
        If .lst.ListItems.Count < 1 Then
            Kill Dados
            Me.Atualiza_Acoes
            Exit Sub
        End If
        
        .pbr.Max = .lst.ListItems.Count
        .pbr.Value = 0
        
        Open Dados For Output As 1
        
            Do While .pbr.Value < .pbr.Max
                .pbr.Value = .pbr.Value + 1
                .lst.ListItems.Item(.pbr.Value).Selected = True
                Print #1, .lst.SelectedItem.Text & "//" & .lst.SelectedItem.SubItems(1)
            Loop
        Close #1
        .pbr.Value = 0
    End With
Exit Sub
erro:
MsgBox "Erro ao excluir registro! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub


Sub Mostrar()
On Error GoTo erro
    With frmCli
        If Dir(Dados) = "" Then
            'não há dados
            Else
            Dim Texto, ls As ListItem, Ch, Num
            Ch = 0
            Texto = ""
            Num = 0
            .lst.ListItems.Clear
            Open Dados For Input As 1
                Do While EOF(1) = False
                    Line Input #1, Texto
                    Num = Num + 1
                Loop
            Close #1
            .pbr.Value = 0
            .pbr.Max = Num
            
            Open Dados For Input As 1
                Do While EOF(1) = False
                    Ch = Ch + 1
                    .pbr.Value = Ch
                    Line Input #1, Texto
                    Texto = Split(Texto, "//")
                    Set ls = .lst.ListItems.Add(, Ch & "chave", Texto(0))
                    ls.SubItems(1) = Texto(1)
                   
                Loop
            Close #1
        End If
        .pbr.Value = 0
    End With
Exit Sub
erro:
MsgBox "Erro ao listar dados! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Carregar()
On Error GoTo erro
    With frmCli
        If .tbr.Buttons(3).Enabled = False Then Exit Sub
        frmCad.txtNome.Text = .lst.SelectedItem
        frmCad.txtTel.Text = .lst.SelectedItem.SubItems(1)
      
        
        
        
        
        
        
        
        
       
        frmCad.cmdGRavar.Enabled = False
        frmCad.Caption = "Alterando cadastro selecionado..."
        frmCad.Show 1
    End With
Exit Sub
erro:
MsgBox "Erro ao solicitar alteração dos dados! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Link to post
Share on other sites
  • 0

Prezado Raphael:

Primeiramente obrigado pela gentileza de responder ao meu post.

Abaixo estou colando o código original da pasta Class Modules.

Caso você necessite do projeto completo posso te enviar por e-mail.

Grande abraço. Frata.

Sub Solicita_Novo()
On Error GoTo erro
    frmCad.Caption = "Adicionando novo cadastro..."
    frmCad.Show 1, frmCli
Exit Sub
erro:
MsgBox "Erro ao solicitar novo registro! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Atualiza_Acoes()
On Error GoTo erro
With frmCli.tbr
    If Dir(Dados) = "" Then
        .Buttons(3).Enabled = False
        .Buttons(5).Enabled = False
        .Buttons(7).Enabled = False
        Else
        .Buttons(3).Enabled = True
        .Buttons(5).Enabled = True
        .Buttons(7).Enabled = True
    End If
    Me.Mostrar
    If frmCli.lst.ListItems.Count < 1 Then
        .Buttons(3).Enabled = False
        .Buttons(5).Enabled = False
        .Buttons(7).Enabled = False
        Else
        .Buttons(3).Enabled = True
        .Buttons(5).Enabled = True
        .Buttons(7).Enabled = True
    End If
End With
Exit Sub
erro:
MsgBox "Erro ao atualizar ações! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Gravar()
On Error GoTo erro
    Open Dados For Append As 1
        With frmCad
            Print #1, .txtNome.Text & "//" & .txtTel.Text
        End With
    Close #1
    Unload frmCad
    Me.Atualiza_Acoes
    MsgBox "Registro gravado com sucesso!", vbInformation, "Informação"
Exit Sub
erro:
MsgBox "Erro ao gravar registro! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Alterar()
On Error GoTo erro
    With frmCli
    
        .lst.SelectedItem = frmCad.txtNome.Text
        .lst.SelectedItem.SubItems(1) = frmCad.txtTel.Text
        Unload frmCad
        
        .pbr.Max = .lst.ListItems.Count
        .pbr.Value = 0
        
        Open Dados For Output As 1
        
            Do While .pbr.Value < .pbr.Max
                .pbr.Value = .pbr.Value + 1
                .lst.ListItems.Item(.pbr.Value).Selected = True
                Print #1, .lst.SelectedItem.Text & "//" & .lst.SelectedItem.SubItems(1)
            Loop
        Close #1
        .pbr.Value = 0
        MsgBox "Registro alterado com sucesso!", vbInformation, "Informação"
    End With
Exit Sub
erro:
MsgBox "Erro ao alterar registro! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Excluir()
On Error GoTo erro
    With frmCli
    
                
        If MsgBox("Deseja realmente excluir o registro selecionado?", 4 + 32, "Exclusão") <> 6 Then Exit Sub
        
        .lst.ListItems.Remove (.lst.SelectedItem.Index)
        
        If .lst.ListItems.Count < 1 Then
            Kill Dados
            Me.Atualiza_Acoes
            Exit Sub
        End If
        
        .pbr.Max = .lst.ListItems.Count
        .pbr.Value = 0
        
        Open Dados For Output As 1
        
            Do While .pbr.Value < .pbr.Max
                .pbr.Value = .pbr.Value + 1
                .lst.ListItems.Item(.pbr.Value).Selected = True
                Print #1, .lst.SelectedItem.Text & "//" & .lst.SelectedItem.SubItems(1)
            Loop
        Close #1
        .pbr.Value = 0
    End With
Exit Sub
erro:
MsgBox "Erro ao excluir registro! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub


Sub Mostrar()
On Error GoTo erro
    With frmCli
        If Dir(Dados) = "" Then
            'não há dados
            Else
            Dim Texto, ls As ListItem, Ch, Num
            Ch = 0
            Texto = ""
            Num = 0
            .lst.ListItems.Clear
            Open Dados For Input As 1
                Do While EOF(1) = False
                    Line Input #1, Texto
                    Num = Num + 1
                Loop
            Close #1
            .pbr.Value = 0
            .pbr.Max = Num
            
            Open Dados For Input As 1
                Do While EOF(1) = False
                    Ch = Ch + 1
                    .pbr.Value = Ch
                    Line Input #1, Texto
                    Texto = Split(Texto, "//")
                    Set ls = .lst.ListItems.Add(, Ch & "chave", Texto(0))
                    ls.SubItems(1) = Texto(1)
                Loop
            Close #1
        End If
        .pbr.Value = 0
    End With
Exit Sub
erro:
MsgBox "Erro ao listar dados! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Sub Carregar()
On Error GoTo erro
    With frmCli
        If .tbr.Buttons(3).Enabled = False Then Exit Sub
        frmCad.txtNome.Text = .lst.SelectedItem
        frmCad.txtTel.Text = .lst.SelectedItem.SubItems(1)
        frmCad.cmdGRavar.Enabled = False
        frmCad.Caption = "Alterando cadastro selecionado..."
        frmCad.Show 1
    End With
Exit Sub
erro:
MsgBox "Erro ao solicitar alteração dos dados! " & Err.Description, vbCritical, "Erro n.º " & Err.Number
End Sub

Link to post
Share on other sites

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.



  • Forum Statistics

    • Total Topics
      149408
    • Total Posts
      645900
×
×
  • Create New...