Excel - Enviar una Hoja de Calculo Oculta por Correo

hFile = FreeFile

Open "FileName.txt" For Output As #hFile

Print #hFile, Range("A1").Value

Close #hFile

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

            'Estamos utilizando 97-2003...

            FileExtStr = ".xls": FileFormatNum = -4143

        Else

            'Estamos utilizando 2007-2010. Salimos de la macro cuando respondemos

            'NO en el cuadro de diálogo de seguridad que vemos cuando copiamos

            '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

    '    'Eliminamos las comillas de las siguiente líneas

    '    'si queremos sustituir las fórmulas por valores

    '    With Destwb.Sheets(1).UsedRange

    '        .Cells.Copy

    '        .Cells.PasteSpecial xlPasteValues

    '        .Cells(1).Select

    '    End With

    '    Application.CutCopyMode = False

    'Grabamos la hoja que enviaremos 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", "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