Цей код зберігає аркуш як нову книгу та створює електронний лист у Outlook із додаванням нової книги. Це дуже корисно, якщо у вас є стандартизована таблиця шаблонів, яка використовується у вашій організації.
Для більш простого прикладу подивіться, як надіслати електронну пошту з Excel
Збережіть аркуш як нову книгу та додайте до електронної пошти
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108 | Sub Mail_Workbook ()Application.DisplayAlerts = НеправдаApplication.enableevents = НеправдаApplication.ScreenUpdating = НеправдаApplication.Calculation = xlCalculationManualЗатемнити OutApp як об'єктПриглушити пошту як об’єктЗатемнити FilePath як рядокDim Project_Name As StringDim Template_Name As StringDim ReviewDate As StringЗатемнити SaveLocation як рядокЗатемнити шлях як рядокЗатемнити ім'я як рядок'Створіть початкові змінніВстановіть OutApp = CreateObject ("Outlook.Application")Встановити OutMail = OutApp.CreateItem (0)Project_Name = Аркуші ("sheet1"). Діапазон ("ProjectName"). ЗначенняTemplate_Name = Ім'я ActiveSheet'Вимагайте введення даних, що використовуються в електронній поштіReviewDate = InputBox (Prompt: = "Укажіть дату, до якої ви хочете переглянути подання.", Title: = "Введіть дату", Default: = "MM/DD/YYYY")Якщо ReviewDate = "Введіть дату" або ReviewDate = vbNullString Тоді перейдіть до endmacro'Зберегти аркуш як власну книгуШлях = ActiveWorkbook.PathНазва = Обрізати (Середина (ActiveSheet.Name, 4, 99))Встановіть ws = ActiveSheetВстановити oldWB = ThisWorkbookSaveLocation = InputBox (Підказка: = "Виберіть ім'я файлу та розташування", заголовок: = "Зберегти як", за замовчуванням: = CreateObject ("WScript.Shell"). SpecialFolders ("Робочий стіл") & "/" & Ім'я & ". xlsx ")Якщо Dir (SaveLocation) "" ТодіMsgBox ("Файл з такою назвою вже існує. Виберіть нову назву або видаліть існуючий файл.")SaveLocation = InputBox (Підказка: = "Виберіть ім'я файлу та розташування", заголовок: = "Зберегти як", за замовчуванням: = CreateObject ("WScript.Shell"). SpecialFolders ("Робочий стіл") & "/" & Ім'я & ". xlsx ")Закінчити ЯкщоЯкщо SaveLocation = vbNullString Тоді перейдіть до endmacro'зняти захист аркуша, якщо це необхідноActiveSheet.Unprotect Password: = "пароль"Встановити newWB = Робочі книги. Додати'Налаштувати дисплейActiveWindow.Zoom = 80ActiveWindow.DisplayGridlines = Неправда'Копіювати + Вставляти значенняoldWB.АктивуйтеoldWB.ActiveSheet.Cells.SelectВибір. КопіюватиnewWB.АктивуватиnewWB.ActiveSheet.Cells.SelectSelection.PasteSpecial Paste: = xlPasteValues, Операція: = xlNone, SkipBlanks _: = False, Транспонування: = FalseSelection.PasteSpecial Paste: = xlPasteFormats, Операція: = xlNone, _SkipBlanks: = False, Transpose: = FalseSelection.PasteSpecial Paste: = xlPasteValidation, Операція: = xlNone, _SkipBlanks: = False, Transpose: = False'Виберіть новий СБ і вимкніть режим копіюванняnewWB.ActiveSheet.Range ("A10"). ВиберітьApplication.CutCopyMode = Неправда'Зберегти файлnewWB.SaveAs Ім'я файлу: = SaveLocation, _Формат файлу: = xlOpenXMLWorkbook, CreateBackup: = НеправдаFilePath = Application.ActiveWorkbook.FullName'Захистіть старий WBoldWB.ActiveSheet.Protect Пароль: = "пароль", DrawingObjects: = Правда, Вміст: = Правда, Сценарії: = Правда _, AllowFormattingCells: = True, AllowFormattingColumns: = True, _AllowFormattingRows: = Правда'Електронна поштаУвімкнути Помилка Відновити ДаліЗ OutMail.to = "[email protected]".CC = "".BCC = "".Subject = Назва_проекту & ":" & Назва_шаблону & "для огляду".Body = "Назва проекту:" & Назва_проекту & "," & Назва & "Для перевірки" & ReviewDate.Attachments.Add (FilePath).Дисплей'.Send' Необов'язковий для автоматизації надсилання електронної пошти.Закінчити зПомилка Перейти до 0Встановити OutMail = НічогоВстановити OutApp = Нічого'Завершити макрос, відновити оновлення екрана, Calcs тощо… endmacro:Application.DisplayAlerts = ПравдаApplication.enableevents = ІстинаApplication.ScreenUpdating = ІстинаApplication.Calculation = xlCalculationAutomaticEnd Sub |
