Cómo enviar adjunta por correo electrónico una hoja de Excel

Una de las consultas más habituales en los foros de Excel es acerca de la posibilidad de enviar por correo electrónico la hoja con la que se está trabajando en ese momento (la hoja activa). Buscando información acerca de ello, he encontrado un código que tras modificarlo, lo publico. La verdad es que no recuerdo el mensaje en concreto. Lo que sí sé es que fue publicado en el foro de Mr. Excel.

El usuario trabaja con hojas de cálculo que se actualizan automáticamente cada 2 o 3 minutos con información sobre bolsa. Al actualizarse esa información, se ejecutan unos cálculos que dan ciertos resultados. Era de vital importancia que la hoja fuese enviada lo más rápidamente posible para ganar tiempo a sus competidores.

El código para enviar por correo electrónico la hoja activa es el siguiente:

    Sub EnviarHojaActiva()
    'Este código funciona en las versiones 97-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim I As Long

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

    Set Sourcewb = ActiveWorkbook

    'Copia la hoja a un libro nuevo
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Determina la versión de Excel y la extensión del archivo
    With Destwb
    If Val(Application.Version) < 12 Then
    'Estás utilizando 97-2003...
    FileExtStr = ".xls": FileFormatNum = -4143
    Else
    'Estás utilizando 2007, 2010 o 2013. Sale de la macro al responder
    'NO en el cuadro de diálogo de seguridad que aparece cuando copias
    'una hoja desde un archivo xlsm con las macros deshabilitadas.
    If Sourcewb.Name = .Name Then
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    MsgBox "Has respondido no en el cuadro de diálogo de seguridad"
    Exit Sub
    Else
    Select Case Sourcewb.FileFormat
    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
    Case 52:
    If .HasVBProject Then
    FileExtStr = ".xlsm": FileFormatNum = 52
    Else
    FileExtStr = ".xlsx": FileFormatNum = 51
    End If
    Case 56: FileExtStr = ".xls": FileFormatNum = 56
    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
    End Select
    End If
    End If
    End With

    ' 'Elimina las comillas de las siguiente líneas
    ' 'si quieres sustituir las fórmulas por valores
    ' With Destwb.Sheets(1).UsedRange
    ' .Cells.Copy
    ' .Cells.PasteSpecial xlPasteValues
    ' .Cells(1).Select
    ' End With
    ' Application.CutCopyMode = False

    'Graba la hoja que se enviará por correo
    TempFilePath = Environ$("temp") & ""
    TempFileName = "Parte de " & Sourcewb.Name & " " _
    & Format(Now, "dd-mmm-yy h-mm-ss")

    With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, _
    FileFormat:=FileFormatNum
    On Error Resume Next
    For I = 1 To 3
    ' Modifica el correo del destinatario y el asunto
    .SendMail "CORREO@MIDOMINIO.COM", "Este es el asunto"
    If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
    .Close SaveChanges:=False
    End With

    'Elimina el archivo temporal que se ha creado
    Kill TempFilePath & TempFileName & FileExtStr

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

Al ejecutar la macro se abrirá un cuadro solicitando permiso para enviar el correo. Es una medida de seguridad para prevenir posibles envíos no autorizados.

¿Te ha servido el artículo? Házmelo saber!