Tento kód uloží pracovný hárok ako nový zošit a vytvorí e -mail v programe Outlook s priloženým novým zošitom. Je to veľmi užitočné, ak máte štandardizovanú tabuľku šablón, ktorá sa používa vo vašej organizácii.
Jednoduchší príklad nájdete v téme Ako odosielať e -maily z Excelu
Uložte pracovný hárok ako nový zošit a priložte k e -mailu
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108 | Sub Mail_Workbook ()Application.DisplayAlerts = FalseApplication.enableevents = FalseApplication.ScreenUpdating = FalseApplication.Calculation = xlCalculationManualDim OutApp ako objektDim OutMail ako objektDim FilePath ako reťazecDim Project_Name ako reťazecDim Template_Name ako reťazecDim ReviewDate ako reťazecDim SaveLocation As StringTmavá cesta ako reťazecDim meno ako reťazec'Vytvorte počiatočné premennéSet OutApp = CreateObject ("Outlook.Application")Set OutMail = OutApp.CreateItem (0)Project_Name = hárky ("sheet1"). Rozsah ("ProjectName"). HodnotaTemplate_Name = ActiveSheet.Name„Požiadajte o vstup použitý v e -maileReviewDate = InputBox (výzva: = "Zadajte dátum, dokedy chcete, aby bol príspevok skontrolovaný.", Názov: = "Zadajte dátum", predvolené: = "MM/DD/RRRR")Ak ReviewDate = "Zadajte dátum" alebo ReviewDate = vbNullString, potom prejdite na endmacro„Uložiť pracovný hárok ako vlastný zošitCesta = ActiveWorkbook.PathName = Trim (Mid (ActiveSheet.Name, 4, 99))Nastaviť ws = ActiveSheetNastaviť oldWB = ThisWorkbookSaveLocation = InputBox (Prompt: = "Choose File Name and Location", Title: = "Save As", Default: = CreateObject ("WScript.Shell"). SpecialFolders ("Desktop") & "/" & Name & ". xlsx “)Ak Dir (SaveLocation) "" PotomMsgBox („Súbor s týmto názvom už existuje. Vyberte nový názov alebo odstráňte existujúci súbor.“)SaveLocation = InputBox (Prompt: = "Choose File Name and Location", Title: = "Save As", Default: = CreateObject ("WScript.Shell"). SpecialFolders ("Desktop") & "/" & Name & ". xlsx “)Koniec AkAk SaveLocation = vbNullString Then GoTo endmacro„V prípade potreby nechráňte listActiveSheet.Unprotect heslo: = "heslo"Nastaviť novéWB = zošity'Upravte zobrazenieActiveWindow.Zoom = 80ActiveWindow.DisplayGridlines = False„Kopírovať + prilepiť hodnotyoldWB. AktivovaťoldWB.ActiveSheet.Cells.SelectVýber. KopírovaťnewWB.ActivatenewWB.ActiveSheet.Cells.SelectSelection.PasteSpecial Paste: = xlPasteValues, prevádzka: = xlNone, SkipBlanks _: = Nepravda, Transponovať: = NepravdaSelection.PasteSpecial Paste: = xlPasteFormats, prevádzka: = xlNone, _SkipBlanks: = False, Transpose: = FalseSelection.PasteSpecial Paste: = xlPasteValidation, Prevádzka: = xlNone, _SkipBlanks: = False, Transpose: = False'Vyberte nové WB a vypnite režim rezonancienewWB.ActiveSheet.Range ("A10"). VyberteApplication.CutCopyMode = False'Uloženie súborunewWB.SaveAs Názov súboru: = SaveLocation, _FileFormat: = xlOpenXMLWorkbook, CreateBackup: = FalseFilePath = Application.ActiveWorkbook.FullName„Opravte starú WBoldWB.ActiveSheet.Protect Heslo: = "heslo", DrawingObjects: = pravda, obsah: = pravda, scenáre: = pravda _, AllowFormattingCells: = True, AllowFormattingColumns: = True, _AllowFormattingRows: = True'E -mailPri chybe Pokračovať ďalejS OutMail.to = "[email protected]".CC = "".BCC = "".Subject = Project_Name & ":" & Template_Name & "na kontrolu".Body = "Názov projektu:" & Project_Name & "," & Názov & "Na kontrolu do" & ReviewDate.Attachments.Add (FilePath).Displej'. Odoslať' Voliteľné na automatizáciu odosielania e -mailov.Ukončiť sPri chybe GoTo 0Set OutMail = NičSet OutApp = Nič„Ukončiť makro, obnoviť aktualizáciu obrazovky, kalkusy atď… endmacro:Application.DisplayAlerts = PravdaApplication.enableevents = PravdaApplication.ScreenUpdating = TrueApplication.Calculation = xlCalculationAutomaticKoniec pod |
