Ir para conteúdo
Fórum Script Brasil
  • 0

Agenda em TXT

frata

Perguntado por frata,

 Share

Pergunta

frata

frata

Postado
Postado

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 para o comentário
Compartilhar em outros sites

3 respostass a esta questão

Posts Recomendados

  • 0
frata

frata

Postado
  • Autor
Postado

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 para o comentário
Compartilhar em outros sites
  • 0
frata

frata

Postado
  • Autor
Postado

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 para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...