PROBLEMA AO ENVIAR MAIS DE UM ANEXO NO EMAIL - VB6

FERNANDORUBIM 07/08/2012 17:28:34
#407441

pessoal, peguei essa rotina (vb6) e adaptei ao meu sistema porem nao funciona quando existem 2 ou mais anexos...todos os anexos são em pdf... se tem apenas um funciona, onde tem mais de um não envia o email...alguem sabe o q está errado ????

Dim Msg As CDO.Message
Dim Cof As CDO.Configuration
Dim Camp
Dim arqanexo as string
Set Msg = New CDO.Message
Set Cof = New CDO.Configuration
Set Camp = Cof.Fields

txtNomeCC = [Ô][Ô]

Me.Enabled = False
Label_Titulo.Caption = [Ô] Enviando email... AGUARDE POR FAVOR ........[Ô] [ô]Configuração

DoEvents
With Camp
.Item(cdoSMTPServerPort) = 465 [ô][ô] 587 [ô][ô]txtPortaSMTP.Text
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = [Ô]smtp.gmail.com[Ô]
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSMTPUseSSL) = True
.Item(cdoSendUserName) = [Ô]xxxxxxxxxxxx@xxxxxx.com.br[Ô] [ô][ô]
.Item(cdoSendPassword) = [Ô]9999999[Ô]
.Update
End With

DoEvents
With Msg
Set .Configuration = Cof
If Trim(txtNomeCC) = [Ô][Ô] Then
.To = [Ô]<[Ô] & Txt_Para.Text & [Ô]>[Ô]
Else
.To = [Ô]<[Ô] & Txt_Para.Text & [Ô]>[Ô] & [Ô];[Ô] & [Ô]<[Ô] & txtNomeCC.Text & [Ô]>[Ô]
End If
.From = WG_cd_usuario & [Ô] <[Ô] & Trim(Txt_De.Text) & [Ô]>[Ô]
.Subject = Txt_Assunto.Text
.TextBody = txt_mensagem.Text
.Attachments.DeleteAll
nIndAnexo = 0

ver_anexos:
If lstAnexos(nIndAnexo) <> [Ô][Ô] Then
arqanexo = lstAnexos(nIndAnexo)
.AddAttachment arqanexo
nIndAnexo = nIndAnexo + 1
GoTo ver_anexos
End If
.Send
End With

DoEvents
Select Case Err.Number
Case 0
MsgBox ([Ô]Email enviado com sucesso![Ô])
[ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô]
Case Else
MsgBox ([Ô]Ocorreu um falha no envio da mensagem.[Ô])
End Select