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 "[email protected]", "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!
