Šis kods saglabā darblapu kā jaunu darbgrāmatu un izveido e -pastu programmā Outlook ar pievienotu jauno darbgrāmatu. Tas ir ļoti noderīgi, ja jums ir standartizēta veidņu izklājlapa, kas tiek izmantota visā jūsu organizācijā.
Vienkāršāku piemēru skatiet sadaļā Kā nosūtīt e -pastu no Excel
Saglabājiet darblapu kā jaunu darbgrāmatu un pievienojiet e -pastam
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108 | Apakšpasts_ darba grāmata ()Application.DisplayAlerts = NepareiziApplication.enableevents = NepareiziApplication.ScreenUpdating = NepareiziApplication.Calculation = xlCalculationManualIzgaismojiet lietotni kā objektuDim OutMail kā objektsAptumšojiet FilePath kā virkniDim Project_Name kā virkneDim Template_Name As StringDim pārskatīšanas datums kā virkneSaglabāt atrašanās vietu kā virkniAptumšot ceļu kā virkniDim nosaukums kā virkne'Izveidojiet sākotnējos mainīgosSet OutApp = CreateObject ("Outlook.Application")Iestatīt OutMail = OutApp.CreateItem (0)Project_Name = Sheets ("sheet1"). Diapazons ("ProjectName"). VērtībaTemplate_Name = ActiveSheet.Name'Jautājiet e -pastā izmantoto ievadiReviewDate = InputBox (Prompt: = "Norādiet datumu, līdz kuram vēlaties pārskatīt iesniegumu.", Title: = "Ievadiet datumu", Noklusējums: = "MM/DD/YYYY")Ja ReviewDate = "Ievadiet datumu" Vai ReviewDate = vbNullString, tad GoTo endmacro'Saglabājiet darblapu kā savu darbgrāmatuCeļš = ActiveWorkbook.PathNosaukums = apgriešana (vidēja (ActiveSheet.Name, 4, 99))Iestatiet ws = ActiveSheetSet oldWB = Šī darba grāmataSaveLocation = InputBox (Prompt: = "Izvēlieties faila nosaukumu un atrašanās vietu", nosaukums: = "Saglabāt kā", Noklusējums: = CreateObject ("WScript.Shell"). SpecialFolders ("Desktop") & "/" & Name & ". xlsx ")Ja Dir (SaveLocation) "" TadMsgBox ("Fails ar šādu nosaukumu jau pastāv. Lūdzu, izvēlieties jaunu nosaukumu vai izdzēsiet esošo failu.")SaveLocation = InputBox (Prompt: = "Izvēlieties faila nosaukumu un atrašanās vietu", nosaukums: = "Saglabāt kā", Noklusējums: = CreateObject ("WScript.Shell"). SpecialFolders ("Desktop") & "/" & Name & ". xlsx ")Beigas JaJa SaveLocation = vbNullString, tad GoTo endmacro'ja nepieciešams, neaizsargājiet lapuActiveSheet.Unprotect Password: = "parole"Iestatīt jaunuWB = darbgrāmatas. Pievienot"Pielāgot displejuActiveWindow.Zoom = 80ActiveWindow.DisplayGridlines = Nepareizi'Kopēt + ielīmēt vērtībasoldWB. AktivizētoldWB.ActiveSheet.Cells.SelectAtlase. KopētnewWB. AktivizētnewWB.ActiveSheet.Cells.SelectSelection.PasteSpecial Paste: = xlPasteValues, darbība: = xlNone, SkipBlanks _: = Nepareizi, Transponēt: = NepareiziSelection.PasteSpecial Paste: = xlPasteFormats, darbība: = xlNone, _SkipBlanks: = False, Transpose: = FalseSelection.PasteSpecial Paste: = xlPasteValidation, Operation: = xlNone, _SkipBlanks: = False, Transpose: = False'Izvēlieties jaunu WB un izslēdziet kopēšanas režīmunewWB.ActiveSheet.Range ("A10"). AtlasietApplication.CutCopyMode = Nepareizs'Saglabāt failunewWB.SaveAs Faila nosaukums: = SaveLocation, _FileFormat: = xlOpenXMLWorkbook, CreateBackup: = NepareizsFilePath = Application.ActiveWorkbook.FullName'Aizsargāt veco PBoldWB.ActiveSheet.Protect Parole: = "parole", DrawingObjects: = True, Contents: = True, Scenāriji: = True _, AllowFormattingCells: = True, AllowFormattingColumns: = True, _AllowFormattingRows: = True'E -pastsPar kļūdu Atsākt nākamoAr OutMail.to = "[email protected]".CC = "".BCC = "".Subject = Project_Name & ":" & Template_Name & "pārskatīšanai".Body = "Projekta nosaukums:" & Project_Name & "," & Name & "Pārskatīšanai pēc" & ReviewDate.Attachments.Add (FilePath).Displejs'.Sūtīt' Neobligāti, lai automatizētu e -pasta sūtīšanu.Beigt arKļūda GoTo 0Set OutMail = NekasSet OutApp = Nekas'Beigt makro, atjaunot ekrāna atjaunināšanu, kalcus utt … endmacro:Application.DisplayAlerts = PatiessApplication.enableevents = PatiessApplication.ScreenUpdating = PatiessApplication.Calculation = xlCalculationAutomaticBeigu apakš |
