Guru do Excel e Power BI

Senhores

Boa Tarde

Ao tentar executar a Macro abaixo a partir do botão 'ENVIAR", nada acontece
ou seja os e-mail's não são gerados e nem emitidos, pois a tela fica 'PARADA'.
Me parece-que a macro não é startada, pois os totais finais não são exbidos.

Um detalhe: o outlook emite constatemente a seguinte mensagem:
O servidor IMAP encerrou sua conexão
Protocolo: IMAP
Servidor: imap.uol.com.br
Porta: 993
Código erro: ox800CCCDD

A Macro é a seguinte:
Sub EnviarEmail()
'Escrito por Laennder (gurudoexcel.com/forum)
Dim sTO As String 'Destinatario
Dim sCC As String 'Destinatário Cópia
Dim sMEs As String 'Mês
Dim sNome As String 'Nome do Cliente
Dim dValor As Double 'Valor Devido
Dim i As Integer 'Contador
Dim Total As Integer
Dim Qty As Integer
Dim sht As Worksheet

'Defina a planilha onde estão os dados
Set sht = Plan4
sMEs = InputBox("Digite o mes referente as refeições: exemplo 'Abril/2015' ", _
"Mês referente", UCase(Format(Date - 1, "MMMM") & "/" & Format(Date - 1, "YYYY")))
Qty = WorksheetFunction.CountA(Plan1.Columns(1))
For i = 2 To Qty
sNome = sht.Cells(i, 1) 'Coluna 1 (A)
dValor = sht.Cells(i, 27) 'Coluna 27 (AA)
sTO = sht.Cells(i, 2) 'Coluna 2 (B)
sCC = "c.tavares@uol.com.br"
If sTO <> "" And dValor > 0 Then

'Enviar email
Dim oOutlookApp As Object
Dim oOutlookMessage As Object
Dim ns As Outlook.Namespace
Dim Folder As Outlook.MAPIFolder
'Instacia os objetos
Set oOutlookApp = New Outlook.Application
Set oOutlookMessage = oOutlookApp.CreateItem(olMailItem)
Set ns = oOutlookApp.GetNamespace("MAPI")
Set oOutlookApp = ns.GetDefaultFolder(olFolderInbox)
oOutlookMessage.HTMLBody = "<p>Prezado(a) " & sNome & ", </p>" _
& "<p>O valor total das suas refeições em " & sMEs & " foi de R$: " & Format(dValor, "#,##0.00") & "</p>" _
& "Atenciosamente, "
With oOutlookMessage
.Subject = "Valor de Suas Refeições"
.to = sTO
.CC = sCC
'.Display
.Send
End With
oOutlookApp.Quit
Set oOutlookApp = Nothing
'fim do envio do email
'Aumenta o contador
Total = Total + 1
End If
Next i
MsgBox "Processo finalizado" & Chr(13) & "Total de emails enviados: " & Total, vbInformation, "AVISO"
End Sub

Public Sub formulario_email()
UserForm1.Show
End Sub

Desde já agradeço

Att.

Claudio Tavares

Claudio, o erro está sendo com o servidor da UOL.

Provavelmente eles estão bloqueado o envio de e-mails (podem estar considerando SPAM).

Verifique com eles se pode ser isso, e o motivo de está recebendo essa mensagem: O servidor IMAP encerrou sua conexão

Laennder,

Boa Noite

Deixe-me incomoda-lo mais uma vez..
Seguinte sua sugestão tentei uma ajuda no suporte da UOL e eles não me ajudaram em nada e
sugeriram passar a utilizar o webmail.
Passei a pesquisar uma solução no google e o que encontrei foram milhares de reclamações e
comentarios dizendo que o provedor IMAP da UOL é uma porcaria..

O que quero lhe perguntar é o seguinte:
Quando executo a Macro pelo comando 'Executar' dentro da Macro ao invés do botão 'Enviar'
os e-mail's são gerados, mas eles vão para a pasta de saida do outlook e não do outlook express.

Voce poderia me dizer o porque???

Grato e Abraços

Claudio, o Ms Outlook e o Outlook Express são programas diferentes. A macro é para enviar e-mails via MS Outlook.

Laender

Boa Noite

Acabei de descobrir isso ..(RSRSRSRS)

No ultimo teste que realizei, vi que todos os e-mail's gerados foram para a pasta de
saida do MS Outlook e com o botão 'Enviar' do MS Outlook, pude enviar todos de uma só vez..

O unico problema que continua é o fato do botão 'Enviar' da Macro, não estar funcionando

Grato e Abraços