PROBLEMAS COM ENVIO DE MENSAGEM WINSOCK

 Tópico anterior Próximo tópico Novo tópico

PROBLEMAS COM ENVIO DE MENSAGEM WINSOCK

VB / VBA

 Compartilhe  Compartilhe  Compartilhe
#489409 - 09/07/2019 16:08:10

HOSHIN
IGUATAMA
Cadast. em:Maio/2009


Boa tarde pessoal.
Alguém pode me ajudar no código abaixo. É um código que peguei de um exemplo de envio de email pelo Winsock aqui no vbmania, mas que não consegui fazer com que ele envie a mensagem.
no email que recebo, vem até o Subject preenchido, mas o corpo do email não tem nenhuma mensagem. Marquei de negrito onde esta vindo a mensagem digitada pelo usuário para ser enviada para o email e aparecer no corpo do email de quem recebe.

   If Trim(Winsock1.Tag) <> "" Then
        Winsock1.GetData strData
        Status = Left(strData, 3)
        'Verifica de o servidor retornou alguma msg de erro
        Select Case Status
            Case "250", "220", "354", "221"
                Erro = False
            Case Else:
                Erro = True
                Winsock1.Tag = "fechar"
                Status = Mid(strData, 4)
        End Select
        Select Case Winsock1.Tag
            Case "conectado":
                Winsock1.SendData "helo " & Winsock1.LocalIP & vbCrLf
                Winsock1.Tag = "conectou"
                stbConexao.Panels(1).Text = "Conectado."
            Case "conectou":
                stbConexao.Panels(1).Text = "Enviando..."
                Winsock1.SendData "mail from:<" & txtFrom.Text & ">" & vbCrLf
                Winsock1.Tag = "from"
            Case "from":
                Winsock1.SendData "rcpt to:<" & txtTo.Text & ">" & vbCrLf
                Winsock1.Tag = "to"
            Case "to":
                Winsock1.SendData "data" & vbCrLf
                Winsock1.Tag = "data"
            Case "data":
                'A sequencia "." e quebra de linha deve ser substituida por ".." e quebra de linha
                'para evitar que o servidor entenda fim de email antes do fim do texto
                MsgTexto = txtMsg.Text & vbCrLf
                While InStr(MsgTexto, vbCrLf & "." & vbCrLf) <> 0
                    MsgTexto = Replace(MsgTexto, vbCrLf & "." & vbCrLf, vbCrLf & ".." & vbCrLf)
                Wend
                Winsock1.SendData "subject: " & txtSubject & vbCrLf & "message: " & MsgTexto & vbCrLf & "." & vbCrLf
                Winsock1.Tag = "fim"
            Case "fim":
                stbConexao.Panels(1).Text = "Desconectando..."
                Winsock1.SendData "quit" & vbCrLf
                Winsock1.Tag = "fechar"
            Case "fechar":
                If Not Erro Then
                    stbConexao.Panels(1).Text = "Enviado com sucesso!"
                Else
                    stbConexao.Panels(1).Text = "Erro ao enviar email!"
                    MsgBox Status, vbCritical, "Erro"
                End If
                Winsock1.Close
                Winsock1.Tag = ""
        End Select
    End If

========================================================
Washington Ragone da SIlva Santos
Analista de Sistemas
Pós Graduado em Engenharia de Software

#489412 - 09/07/2019 17:06:19

KERPLUNK
RIO GRANDE DO SUL
Cadast. em:Junho/2009


Membro da equipe
Creio que seja por falta do MIME Type. Veja aqui um outro exemplo, similar o seu

_______________________________________________________________________
Virei Oráculo!
The end is nigh, be ready for the nukes!


#489421 - 10/07/2019 08:56:21

HOSHIN
IGUATAMA
Cadast. em:Maio/2009


Bom dia.
Não consegui mudar o código.
Como ficaria a mudança no código que postei?
Att,

========================================================
Washington Ragone da SIlva Santos
Analista de Sistemas
Pós Graduado em Engenharia de Software

#489423 - 10/07/2019 11:30:50

KERPLUNK
RIO GRANDE DO SUL
Cadast. em:Junho/2009


Membro da equipe
É muito simples, basta adicionar o MIME type na sua mensagem.

_______________________________________________________________________
Virei Oráculo!
The end is nigh, be ready for the nukes!


#489434 - 10/07/2019 14:10:48

HOSHIN
IGUATAMA
Cadast. em:Maio/2009


Kerplunk olha abaixo, fiz assim e não deu certo.

                MsgTexto = txtMsg.Text & vbCrLf
                While InStr(MsgTexto, vbCrLf & "." & vbCrLf) <> 0
                    MsgTexto = Replace(MsgTexto, vbCrLf & "." & vbCrLf, vbCrLf & ".." & vbCrLf)
                Wend
                Winsock1.SendData "subject: " & txtSubject & vbCrLf & "MIME-Version: 1.0" & vbCrLf & MsgTexto & vbCrLf & "." & vbCrLf
                Winsock1.Tag = "fim"

Como mudar o código que enviei?

========================================================
Washington Ragone da SIlva Santos
Analista de Sistemas
Pós Graduado em Engenharia de Software

#489444 - 10/07/2019 15:57:57

KERPLUNK
RIO GRANDE DO SUL
Cadast. em:Junho/2009


Membro da equipe
Como assim "Como mudar o código"? Você faz o que precisa fazer, isso ali é simplesmente uma concatenação...

_______________________________________________________________________
Virei Oráculo!
The end is nigh, be ready for the nukes!


#489446 - 10/07/2019 16:14:56

HOSHIN
IGUATAMA
Cadast. em:Maio/2009


KERPLUNK
Me desculpe, eu não tenho conhecimento de como suar do jeito que me falou no projeto. Por isso que perguntei se era desse jeito, me desculpe pela concatenação.
Ele envia o email normalmente, a única coisa que não está indo é a mensagem  que é digitada na caixa de texto de nome txtMsg.
Se possivel, alguém ver o código que postei na dúvida e me falar onde modificar ele para a mensagem passar a ir no email, fico muito agradecido.

========================================================
Washington Ragone da SIlva Santos
Analista de Sistemas
Pós Graduado em Engenharia de Software

 Tópico anterior Próximo tópico Novo tópico


Para responder este tópico o login é requerido
Se você já possui uma conta de usuário por favor faça seu login
Se você não possui uma conta de usuário use a opção Criar usuário