Prezados, boa noite!

Qual o problema com esse código abaixo, quando chega no metodo .Send aparece a seguinte mensagem "Falha na conexão do transporte com o servidor".

Sub Salvar_Arquivo_Provisório() 'primeiro vc deve criar uma cópia, somente para ser enviada e depois descartada
'On Error Resume Next
ActiveWorkbook.SaveCopyAs Filename:= _
"C:UsersmDesktop" & Format(Date, " Data  dd-mm-yyyy") & ".xlsm" _
'MUDE A LETRA 'm' PARA SEU PC
'1 linha em branco
Call EnviarEmailCDO
End Sub

Sub EnviarEmailCDO()
'On Error Resume Next
Application.ScreenUpdating = False
Dim oMensagem As Object
Dim oConfiguração As Object
Dim sCorpo As String
Dim vFields As Variant
Dim objWS As Object
Dim strCaminho As String
Set objWS = CreateObject("WScript.Shell")

strCaminho = "C:UsersmDesktop" & Format(Date, " Data  dd-mm-yyyy") & ".xlsm" _
'MUDE LETRA 'm' PARA SEU PC
Set oMensagem = CreateObject("CDO.Message")
Set oConfiguração = CreateObject("CDO.Configuration")
oConfiguração.Load -1 'Padrões CDO
Set vFields = oConfiguração.Fields
With vFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Se quiser enviar um e-mail pelo Windows Live:
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"

'Se quiser enviar um e-mail pelo Yahoo, substiua a linha acima por:
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")= " smtp.mail.yahoo.com"

'Se quiser enviar um e-mail pelo GMail, substiua a linha acima por:
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"

'Abaixo você preencherá o nome do usuário. Se o seu e-mail é @hotmail, @xbox, @live,
'@msn ou outros serviços associados à Windows Live, é necessário que você preencha
'o seu endereço completo no campo abaixo.
'Se você usa GMail, você deve suprimir o @gmail.com e no campo abaixo deixar apenas
'o nome do usuário.
'Em relação ao Yahoo, não testei porque não possuo uma conta. No entanto, provavelmente
'é necessário especificar o endereço de e-mail completo uma vez que o Yahoo possui variações
'como @yahoo.com, @yahoo.com.br, @yahoo.co.uk, entre outros.
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "riltonmarques@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxxxxxxx"
.Update
End With
With oMensagem
Set .Configuration = oConfiguração
.To = "riltonmarques@gmail.com" 'mude aqui para alterar o destinatário
.CC = "" 'com cópia
.BCC = "" 'com cópia oculta
.From = "riltonmarques@gmail.com"
.Subject = "Teste E-mail " & Format(Date, " Data  dd-mm-yyyy") & Format(Time, " hora hhh mmm")
.TextBody = sCorpo
'.AddAttachment strCaminho 'aqui o arquivo e anexado.
.Send
End With
MsgBox "E-MAIL ENVIADO COM SUCESSO."
'Application.DisplayAlerts = False
Call excluir_Arquivo_Provisório
End Sub
Sub excluir_Arquivo_Provisório()
On Error Resume Next
Kill "C:UsersmDesktop" & Format(Date, " Data  dd-mm-yyyy") & ".xlsm" _
'MUDE LETRA 'm' PARA SEU PC
'Application.DisplayAlerts = False
'Application.Quit
End Sub

Fico grato

Rilton