Não sei se isto te ajuda, mas dá uma estudada... Assim você cria um componente ... Public Function SendMail(ByVal pstrMailTo As String, _ ByVal pstrMailSender As String, _ ByVal pstrServerName As String, _ ByVal pstrAccountName As String, _ ByVal pstrProxyServer As String, _ ByVal pstrProxyPass As String, _ Optional ByVal pstrMailCC As String, _ Optional ByVal pstrMailBCC As String, _ Optional ByVal pstrMailSubject As String, _ Optional ByVal pstrMailBody As String) As Boolean On Error GoTo Err_SendMail Dim objCDOMail As Object Dim objCDOConfig As Object ' Cria os Objetos CDO Set objCDOMail = CreateObject("CDO.Message") Set objCDOConfig = CreateObject("CDO.Configuration") ' Atribui as propriedades de Recipient With objCDOConfig.Fields .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = pstrServerName .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 0 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = pstrAccountName .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "" .Item("http://schemas.microsoft.com/cdo/configuration/urlproxyserver") = pstrProxyServer .Item("http://schemas.microsoft.com/cdo/configuration/urlproxybypass") = pstrProxyPass .Item("http://schemas.microsoft.com/cdo/configuration/urlgetlatestversion") = True ' Atualiza o objCDOConfig .Update End With ' Atribui as Informações do Email With objCDOMail ' Informa qual a Configuração do Recipient Set .Configuration = objCDOConfig ' Informações de Envio e Body .To = pstrMailTo .Cc = pstrMailCC .Bcc = pstrMailBCC .From = pstrMailSender .Subject = pstrMailSubject .TextBody = pstrMailBody ' Envia os Emails .Send End With ' Informa que o Email foi enviado com sucesso SendMail = True ' Limpa a Memória Set objCDOMail = Nothing Set objCDOConfig = Nothing Exit Function Err_SendMail: ' Retorna o Erro Err.Raise Err.Number, Err.Source, Err.Description ' Informa que o Email foi enviado com sucesso SendMail = False ' Limpa a Memória Set objCDOMail = Nothing Set objCDOConfig = Nothing End Function
