Check the new version here

Popular channels

Envio de mails desde excel. Suma en la Oficina

Bue, estuve como un mes buscando en la red como enviar e-mails con contenido desde Excel para poder enviar alertas por e-mail desde un Excel.
Hasta que porfin encontre uno que tiene todo, absolutamente todo lo que se refiera a envio de emails...pero en Ingles

Así que para aquellos que todavia no están muy duchos con el Inglish, les paso 2 Macros que sirven para enviar contenido por mail desde un excel.

Aclaracion: Solo funciona para Outlook. No Outlook Express o Windows Mail.

Esto es, dado cierto reporte en Excel, si sucede tal o cual cosa, entonces se envía un e-mail a un destinatario X para avisarle y que actúe sobre eso.

En estos ejemplos hay distintas formas de enviar el contenido por mail.
(Ojo que siempre estamos hablando de macros que deben ejecutarse, eh?)

Bueno, esto sirve mucho para la gente de Oficina, que solo tiene acceso al paquete Office y un Outlook.
Necesitan un poquitito así de conocimiento de Macros en Excel y listo el pollo. (Lo aclaro para que despues no diganm eh??)

Enviar UNA hoja.
Enviar un RANGO o SELECCION.



Enviar UNA hoja.

Sub Mail_Hoja_Outlook_EnElBody()
' No te olvides de copiar la funcion RangetoHTML en el mismo modulo.
' Funciona en Office 2000 a 2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
Set rng = ActiveSheet.UsedRange
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "Aca va el saunto del mail"
.HTMLBody = RangetoHTML(rng)
.Send 'or use .Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Function RangetoHTML(rng As Range)
' Autor: Ron de Bruin 28-Oct-2006
' Funciona en Office 2000 a 2007
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copia el rango y crea un nuevo Libro
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Ahora publica la hoja en un nuevo HTML

With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Pasa todo lo del HTML a RangetoHTML

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Cerrar TempWB
TempWB.Close savechanges:=False

'Borrar el archivo htm que usamos en esta funcion
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function



Enviar un RANGO o SELECCION.




Sub Mail_Seleccion_Rango_Outlook_Body()
' No te olvides de copiar la funcion RangetoHTML en el mismo modulo.
' Funciona en Office 2000 a 2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next
'Solo las celdas visibles de la seleccion
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'O sino podes usar un Rango de celdas
'Set rng = Sheets("Hojax").Range("D412").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "La seleccion no es un rango o la hoja está protegida" & _
vbNewLine & "por favor, corregir e intentar nuevamente", vbOKOnly
Exit Sub
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "Aca va el saunto"
.HTMLBody = RangetoHTML(rng)
.Send 'or use .Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Function RangetoHTML(rng As Range)
' Hecha por Ron de Bruin 28-Oct-2006
' Funciona en Office 2000 a 2007
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copia los datos y los pega en un libro nuevo
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Pega la hoja en un nuevo archivo HTML
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Copiar todo desde el archivo HTML a RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Cerrar TempWB
TempWB.Close savechanges:=False

'Borrar el archivo q creamos
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function





TIPS:

Si queres agregar algunas lineas de texto al cuerpo del mensaje...
Nota: esto no funciona si Word es tu editor de mail por default. en Outlook 2000-2003.

'Agregar esta línea a la macro
Dim StrBody As String
'Lo que quieras escribir
StrBody = "Esta es la linea 1" & "
" & _
"Esta es la linea 2" & "
" & _
"Esta es la linea 3" & "
"
'Y cambia la linea que dice .HTMLBody por esto:
.HTMLBody = StrBody & RangetoHTML(rng)



Si no esta funcionando el envío

1) Van al editor VBA ( Alt + F11 )
2) Herramientas>Referencias
3) Tildan la casilla que dice Microsoft Outlook ? Object Library
? es la version de excel que tienen.



Les paso la fuente donde están todos los ejemplos en Ingles.
http://www.rondebruin.nl/sendmail.htm

Disculpen la desprolijidad, es que estoy en la ruta y el micro se mueve como la gran pu...! :p

Por cierto: No se como hacer para que cada maldito aparezca como lo que es: un " ; )
"

Culaquier duda...Tirense a un pozo! Naaa..pregunten que les ayudo.
[/b][/b]
0
0
0
0
0No comments yet