Tenho Planilha que Envia E-mail Pronto para Outlook - Não quero enviar da conta padrão.

Tenho uma planilha que envia emails para a caixa de saida do Outlook.<br /><br />Quero deixar configurado a conta de envio, não quero enviar da conta padrão.<br /><br />Se preciso envio a planilha.<br /><br />Abaixo o código:<br /><br />Sub Mail_Range_Outlook_Body()<br />' Don't forget to copy the function RangetoHTML in the module.<br />' Working in Office 2000-2007<br />Dim rng As Range<br />Dim OutApp As Object<br />Dim OutMail As Object<br />Dim sendto As String<br />Dim sendcc As String<br />Dim subj As String<br />Dim planilha As String<br />Dim intervalo As String<br />Dim tipo As String<br /><br />Range("C8").Select<br />sendto = ActiveCell<br />Range("C9").Select<br />sendcc = ActiveCell<br />Range("C10").Select<br />subj = ActiveCell<br />Range("C13").Select<br />planilha = ActiveCell<br />Range("C14").Select<br />intervalo = ActiveCell<br /><br />Set rng = Nothing<br />On Error Resume Next<br />'Only the visible cells in the selection<br />'Set rng = [login to view URL](xlCellTypeVisible)<br />'You can also use a range if you want<br />Set rng = Sheets(planilha).Range(intervalo).SpecialCells(xlCellTypeVisible)<br />On Error GoTo 0<br /><br />If rng Is Nothing Then<br />MsgBox "The selection is not a range or the sheet is protected" & _<br />vbNewLine & "please correct and try again.", vbOKOnly<br />Exit Sub<br />End If<br /><br />With Application<br />.EnableEvents = False<br />.ScreenUpdating = False<br />End With<br /><br />Set OutApp = CreateObject("[login to view URL]")<br />[login to view URL]<br />Set OutMail = [login to view URL](0)<br /><br />On Error Resume Next<br />With OutMail<br />.To = sendto<br />.BCC = sendcc<br />.Subject = subj<br />.HTMLBody = RangetoHTML(rng)<br />.Display 'use .Display or .Send or .Save<br />End With<br />On Error GoTo 0<br /><br />With Application<br />.EnableEvents = True<br />.ScreenUpdating = True<br />End With<br /><br />Set OutMail = Nothing<br />Set OutApp = Nothing<br /><br />planilha = Empty<br />intervalo = Empty<br /><br />End Sub<br />Function RangetoHTML(rng As Range)<br />' Changed by Ron de Bruin 28-Oct-2006<br />' Working in Office 2000-2007<br />Dim fso As Object<br />Dim ts As Object<br />Dim TempFile As String<br />Dim TempWB As Workbook<br /><br />TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"<br /><br />'Copy the range and create a new workbook to past the data in<br />[login to view URL]<br />Set TempWB = [login to view URL](1)<br />With [login to view URL](1)<br />.Cells(1).PasteSpecial Paste:=8<br />.Cells(1).PasteSpecial xlPasteValues, , False, False<br />.Cells(1).PasteSpecial xlPasteFormats, , False, False<br />.Cells(1).Select<br />[login to view URL] = False<br />On Error Resume Next<br />.[login to view URL] = True<br />.[login to view URL]<br />On Error GoTo 0<br />End With<br /><br />'Publish the sheet to a htm file<br />With [login to view URL]( _<br />SourceType:=xlSourceRange, _<br />Filename:=TempFile, _<br />Sheet:=[login to view URL](1).Name, _<br />Source:=[login to view URL](1).[login to view URL], _<br />HtmlType:=xlHtmlStatic)<br />.Publish (True)<br />End With<br /><br />'Read all data from the htm file into RangetoHTML<br />Set fso = CreateObject("[login to view URL]")<br />Set ts = [login to view URL](TempFile).OpenAsTextStream(1, -2)<br />RangetoHTML = [login to view URL]<br />[login to view URL]<br />RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _<br />"align=left x:publishsource=")<br /><br />'Close TempWB<br />[login to view URL] savechanges:=False<br /><br />'Delete the htm file we used in this function<br />Kill TempFile<br /><br />Set ts = Nothing<br />Set fso = Nothing<br />Set TempWB = Nothing<br /><br />End Function