Função AddItem não aceita ponto e virgula

Prezado Colegas, boa tarde!
Estou com o seguinte problema, tenho um campo onde vou arquivar todos os e-mails numa base de dado Mysql, ao gravar aceita normalmente gravar dois e-mails separado por ponto e Virgula ( para minha surpresa quando vou chamar o registo gravado apenas aparece um email e não dois como está na imagem da base de dado.

Código:

Private Sub fncCarregaLista()
      Dim cmd As New ADODB.Command
      Dim cn As New ADODB.Connection
      Dim rs As New ADODB.Recordset

10    On Error Resume Next
20         If sErr = -1 Then    'Habilita tratamento de erro
            
30        End If
40        If cn.State = 1 Then    'verificar o status do banco de dados. Se aberto fecha a conexão
50            cn.Close
60       End If
70        If rs.State = 1 Then    'verificar o status do recordeset. Se aberto fecha a conexão
80            rs.Close
90        End If
100    Set cn = New ADODB.Connection

110    With cn
120    Call MySQL_Server    'Carrega parametros do servidor
130       .ConnectionString = "Driver={MySQL ODBC 5.1 Driver};Server=" & MyslqServidor & ";Database=" & MyslqDatabase & ";User=" & MyslqUsuario & ";Password=" & MyslqSenha & ";Port=" & MyslqPorta & ";Option=3;"
140   .Open

150      End With

160   With cmd
170           .ActiveConnection = cn
180           .CommandType = adCmdStoredProc
              '.Parameters.Append cmd.CreateParameter("@pesquisa", adDate, adParamInput, , Me.TxData)
              '.Parameters.Append cmd.CreateParameter("@Banco", adVarChar, adParamInput, 20, Me.Tx2)
190           .CommandText = "Login_Usuario"
200       End With
          
210       With rs
220           .CursorLocation = adUseClient
230           .Open cmd, CursorType:=adOpenStatic, _
              Options:=adCmdStoredProc
240           Set .ActiveConnection = Nothing
250       End With


      'Define a propriedade tipo de origem da linha como Lista de Valores.
260   Me.Lista.RowSourceType = "Value List"

      'Limpa a origem da linha da listbox.
270   Me.Lista.RowSource = ""

      'Define a propriedade número de colunas = 1 coluna.
280   Me.Lista.ColumnCount = 6

      'Define a propriedade coluna acoplada = 1 (cujo valores serão utilizados como valor do controle).
290   Me.Lista.BoundColumn = 1

      'Define apenas um valor na propriedade largura das colunas, haja vista ter declarado acima apenas 1
      'como número de colunas.
300   Me.Lista.ColumnWidths = "3cm;3,702cm;3cm;3cm;3,3cm;10cm"


      'Move para o inicio do recordset
310   rs.MoveFirst


      'Utiliza a instrução with para agir em cima da ListBox, a cada laço, utiliza o método AddItem para preencher as linhas do controle
320   With rs

                          
330       With Me.Lista
              
340           Do While Not rs.EOF
               'Me.Lista.AddItem ";Nome"
              
350             Me.Lista.AddItem rs.Fields("IdUsuario") & ";" & (rs.Fields("usuario") & ";" & rs.Fields("Senha") & ";" & rs.Fields("Bloqueado") & ";" & rs.Fields("email1"))
            
360            rs.MoveNext
370           Loop 'Until rs.EOF
380   rs.Close
390   cn.Close

400   End With
410   End With


420   Set rs = Nothing
430   Set cn = Nothing
End Sub


Olá João Avelino,

Tente onde está a usar:

Código:

;

colocar

Código:

& chr(59)  &

e teste.

Abraço

ahteixeira o campo email1 no mysql já testei char(59) não funcionou.

Olá João Avelino,

Não inha visto o código todo.
Possivelmente está a ler, mas como é o separador, deve estar a por como se fosse para outro campo.
O separador não poderia ser outro sem ser o ponto e vírgula, por exemplo barra | (PIPE)

Abraço

ahteixeira.
Agora só mostra o ultimo email depois da virgula adicionado | (PIPE).

Olá João Avelino,

caso ainda não tenha resolvido o problema, tente substituir, na linha 350, de ";" para "'; '".

Espero ter ajudado.

Abraço

Algumas coisas não ficaram claras:

1. Você queria que preenchesse os dois e-mails do IdUsuario 1 em uma coluna para carregar no campo?
   
2. Como você está carregando o campo com os e-mails ao ativar o evento na ListBox?
   
3. Quantas colunas estão definidas na ListBox?
   

O ";" é um separador para o objeto ListBox quando o RowSource está definido como Lista de Valores, se vem o valor em string que contenha ponto e vírgula, ele será separado em outra coluna.
Você poderia tentar substituir apenas os ponto-e-vírgula do campo em questão, por vírgula, assim não teria esse conflito.

Prezado alfarinha a tua ideia funcionou mais preciso analisar bem, porque campo da caixa de texto está trazer o id seguinte de outro registo, quanto ao Marco Messa a minha ideia é ter um unico campo na tabela onde vou arquivar todos os emails do usuários do sistema.

Avelino João, você não pode vincular a tabela do MySql no seu aplicativo Access e utilizar outro RowSource como Tabela/Consulta? Não teria esse problema com os caracteres e o código ficaria relativamente menor.

Marco Messa Boa Tarde, não posso vincular as tabelas o aplicativo vai trabalhar totalmente vinculado

Bom dia Amigo

Crie uma Sub preencher_lista_email e apos preencher os campos de texto:

Sub preencher_lista_email()
    Dim query As String
    
    query = "SELECT email" & _
    " FROM usuario" & _
    " WHERE idUsuario = '" & idUsuario & "'"
    
    conexao.executar_datareader (query)
    
    Set lista_email.Recordset = Nothing
    Set lista_email.Recordset = conexao.data_reader
    
End Sub

Se o problema é o ponto-e-vírgula armazenado, não o armazene! Na hora de armazenar, faça um replace do ; por algum caractere menos problemático, como o | . E na hora de carregar, faça o replace ao contrário.

Prezado José Machado, bom dia!
Obrigado pela sugestão mais vou tentar ainda o método do sugerido pelo Coltro, depois dou o retorno se resolveu ou não.

Coltro a tua solução resolveu o problema tive que alterar stored procedure dessa forma:

Código:

CREATE PROCEDURE 'Login_Usuario'()
SELECT IdUsuario, usuario, Senha, Bloqueado,REPLACE(email1,';',',')as email1  FROM  tblUsuarios;

Para salvar uso dessa forma a classe:

Código:

Function salvar() As Boolean
10    On Error GoTo Err_salvar

          Dim objCon As New aclConexaoBD
          Dim StrSQL As String

20        If existe(bkpIdUsuario) Then
30          Comando = "Update tblUsuarios " & _
                  "Set IdUsuario = " & objCon.valorSql(IdUsuario) & _
                  ", Bloqueado = " & objCon.valorSql(Bloqueado) & _
                  ", Senha = " & objCon.valorSql(Senha) & _
                  ", Usuario = " & objCon.valorSql(usuario) & _
                  ", Email1 = " & objCon.valorSql(Replace(email1, ",", ";")) & _
                  " Where IdUsuario = " & objCon.valorSql(bkpIdUsuario)

              
40            salvar = True
50            Call execut
60        Else
70            salvar = incluir
80        End If

90        If salvar Then


              'Atualiza as variáveis de backup com o novo valor da chave
120           bkpIdUsuario = IdUsuario
130       End If

Exit_salvar:
140       Exit Function

Err_salvar:
150       salvar = False
160       GoTo Exit_salvar

End Function