Envíe hojas de trabajo por correo electrónico como libros de trabajo separados - Ejemplos de código VBA

Este código guarda una hoja de trabajo como un nuevo libro y crea un correo electrónico en Outlook con el nuevo libro adjunto. Es muy útil si tiene una plantilla de hoja de cálculo estandarizada que se utiliza en toda su organización.

Para obtener un ejemplo más simple, consulte Cómo enviar un correo electrónico desde Excel

Guarde la hoja de trabajo como un nuevo libro de trabajo y adjúntela al correo electrónico

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108

Sub Mail_Workbook ()Application.DisplayAlerts = FalsoApplication.enableevents = FalsoApplication.ScreenUpdating = FalsoApplication.Calculation = xlCalculationManualAtenuar la aplicación como objetoAtenuar OutMail como objetoDim FilePath como cadenaDim Project_Name como cadenaDim Template_Name como cadenaDim ReviewFecha como cadenaDim SaveLocation como cadenaDim Path As StringDim Nombre como cadena'Crear variables inicialesEstablecer OutApp = CreateObject ("Outlook.Application")Establecer OutMail = OutApp.CreateItem (0)Nombre del proyecto = Hojas ("hoja1"). Rango ("Nombre del proyecto"). ValorTemplate_Name = ActiveSheet.Name'Solicitar entrada utilizada en el correo electrónicoReviewDate = InputBox (Solicitud: = "Proporcione la fecha en la que desea que se revise el envío", Título: = "Ingrese la fecha", Predeterminado: = "MM / DD / AAAA")Si ReviewDate = "Ingrese la fecha" o ReviewDate = vbNullString, vaya a endmacro'Guardar hoja de trabajo como libro de trabajo propioRuta = ActiveWorkbook.PathNombre = Recortar (Mid (ActiveSheet.Name, 4, 99))Establecer ws = ActiveSheetEstablecer oldWB = ThisWorkbookSaveLocation = InputBox (Solicitud: = "Elegir nombre y ubicación de archivo", Título: = "Guardar como", Predeterminado: = CreateObject ("WScript.Shell"). SpecialFolders ("Escritorio") & "/" & Nombre & ". xlsx ")Si Dir (SaveLocation) "" EntoncesMsgBox ("Ya existe un archivo con ese nombre. Elija un nombre nuevo o elimine el archivo existente").SaveLocation = InputBox (Solicitud: = "Elegir nombre y ubicación de archivo", Título: = "Guardar como", Predeterminado: = CreateObject ("WScript.Shell"). SpecialFolders ("Escritorio") & "/" & Nombre & ". xlsx ")Terminara siSi SaveLocation = vbNullString, vaya a endmacro'desproteger la hoja si es necesarioActiveSheet.Unprotect Contraseña: = "contraseña"Establecer newWB = Workbooks.Add'Ajustar pantallaActiveWindow.Zoom = 80ActiveWindow.DisplayGridlines = Falso'Copiar + Pegar valoresoldWB.ActivateoldWB.ActiveSheet.Cells.SelectSelección. CopiarnewWB.ActivatenewWB.ActiveSheet.Cells.SelectSelection.PasteSpecial Paste: = xlPasteValues, Operación: = xlNone, SkipBlanks _: = Falso, Transponer: = FalsoSelection.PasteSpecial Paste: = xlPasteFormats, Operación: = xlNone, _SkipBlanks: = False, Transpose: = FalseSelection.PasteSpecial Paste: = xlPasteValidation, Operación: = xlNone, _SkipBlanks: = False, Transpose: = False'Seleccione nuevo WB y desactive el modo de copia de cortenewWB.ActiveSheet.Range ("A10"). SeleccioneApplication.CutCopyMode = False'Guardar el archivonewWB.SaveAs Filename: = SaveLocation, _Formato de archivo: = xlOpenXMLWorkbook, CreateBackup: = FalseFilePath = Application.ActiveWorkbook.FullName'Reproteger oldWBoldWB.ActiveSheet.Protect Contraseña: = "contraseña", DrawingObjects: = True, Contenidos: = True, Escenarios: = True _, AllowFormattingCells: = True, AllowFormattingColumns: = True, _AllowFormattingRows: = Verdadero'Correo electrónicoEn caso de error, reanudar siguienteCon OutMail.to = "[email protected]".CC = "".BCC = "".Subject = Project_Name & ":" & Template_Name & "para revisión".Body = "Nombre del proyecto:" & Project_Name & "," & Name & "Para revisión por" & ReviewDate.Attachments.Add (FilePath).Monitor'.Send' Opcional para automatizar el envío de correo electrónico.Terminar conEn caso de error, vaya a 0Set OutMail = NadaSet OutApp = Nada'Finalizar macro, restaurar actualización de pantalla, cálculos, etc. endmacro:Application.DisplayAlerts = TrueApplication.enableevents = TrueApplication.ScreenUpdating = TrueApplication.Calculation = xlCalculationAutomaticEnd Sub