Innehållsförteckning
Denna kod sparar ett kalkylblad som en ny arbetsbok och skapar ett e -postmeddelande i Outlook med den nya arbetsboken bifogad. Det är mycket användbart om du har ett standardiserat mallkalkylblad som används i hela din organisation.
För ett mer enkelt exempel, se Hur man skickar e -post från Excel
Spara kalkylblad som ny arbetsbok och bifoga till e -post
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108 | Sub Mail_Workbook ()Application.DisplayAlerts = FalsktApplication.enableevents = FalsktApplication.ScreenUpdating = FalsktApplication.Calculation = xlCalculationManualDim OutApp som objektDim OutMail som objektDim FilePath som strängDim Project_Name som strängDim mallnamn som strängDim ReviewDate As StringDim SaveLocation som strängDim Path som strängDim namn som sträng'Skapa initialvariablerAnge OutApp = CreateObject ("Outlook.Application")Ange OutMail = OutApp.CreateItem (0)Project_Name = Sheets ("sheet1"). Område ("ProjectName"). VärdeTemplate_Name = ActiveSheet.Name'Be om inmatning som används i e -postReviewDate = InputBox (Prompt: = "Ange datum senast när du vill att insändningen ska granskas.", Titel: = "Ange datum", Standard: = "MM/DD/ÅÅÅÅ")Om ReviewDate = "Ange datum" Eller ReviewDate = vbNullString Sedan GoTo endmacro'Spara kalkylblad som egen arbetsbokSökväg = ActiveWorkbook.PathNamn = Trim (Mid (ActiveSheet.Name, 4, 99))Ange ws = ActiveSheetAnge oldWB = ThisWorkbookSaveLocation = InputBox (Prompt: = "Välj filnamn och plats", Titel: = "Spara som", Standard: = CreateObject ("WScript.Shell"). SpecialFolders ("Desktop") & "/" & Name & ". xlsx ")If Dir (SaveLocation) "" DåMsgBox ("En fil med det namnet finns redan. Välj ett nytt namn eller ta bort befintlig fil.")SaveLocation = InputBox (Prompt: = "Välj filnamn och plats", Titel: = "Spara som", Standard: = CreateObject ("WScript.Shell"). SpecialFolders ("Desktop") & "/" & Name & ". xlsx ")Avsluta omOm SaveLocation = vbNullString Sedan GoTo slutmakro'oskyddat ark om det behövsActiveSheet.Unprotect Password: = "lösenord"Ställ in newWB = Workbooks.Add'Justera displayenActiveWindow.Zoom = 80ActiveWindow.DisplayGridlines = Falskt'Kopiera + klistra in värdenoldWB.ActivateoldWB.ActiveSheet.Cells.SelectUrval. KopieranewWB.ActivatenewWB.ActiveSheet.Cells.SelectSelection.PasteSpecial Paste: = xlPasteValues, Operation: = xlNone, SkipBlanks _: = Falskt, Transponera: = FalsktSelection.PasteSpecial Paste: = xlPasteFormats, Operation: = xlNone, _SkipBlanks: = Falskt, Transponera: = FalsktSelection.PasteSpecial Paste: = xlPasteValidation, Operation: = xlNone, _SkipBlanks: = Falskt, Transponera: = Falskt'Välj nytt WB och stäng av klipplägetnewWB.ActiveSheet.Range ("A10"). VäljApplication.CutCopyMode = Falskt'Spara filnewWB.SaveAs filnamn: = SaveLocation, _FileFormat: = xlOpenXMLWorkbook, CreateBackup: = FalsktFilePath = Application.ActiveWorkbook.FullName'Skydda om gamlaWBoldWB.ActiveSheet.Protect Password: = "password", DrawingObjects: = True, Contents: = True, Scenarios: = True _, AllowFormattingCells: = True, AllowFormattingColumns: = True, _AllowFormattingRows: = True'E-postVid fel Återuppta nästaMed OutMail.to = "[email protected]".CC = "".BCC = "".Subject = Project_Name & ":" & Template_Name & "för granskning".Body = "Projektnamn:" & Projektnamn & "," & Namn & "För granskning av" & ReviewDate.Attachments.Add (FilePath).Visa'.Skicka' Valfritt för att automatiskt skicka e -post.Sluta medVid fel GoTo 0Set OutMail = IngentingSet OutApp = Ingenting'Avsluta makro, Återställ skärmuppdatering, beräkningar, etc … endmacro:Application.DisplayAlerts = TrueApplication.enableevents = TrueApplication.ScreenUpdating = TrueApplication.Calculation = xlCalculationAutomaticAvsluta Sub |
