Ten kod zapisuje arkusz jako nowy skoroszyt i tworzy wiadomość e-mail w programie Outlook z dołączonym nowym skoroszytem. Jest to bardzo przydatne, jeśli masz ustandaryzowany szablon arkusza kalkulacyjnego, który jest używany w całej organizacji.
Aby uzyskać prostszy przykład, spójrz na Jak wysłać wiadomość e-mail z programu Excel
Zapisz arkusz jako nowy skoroszyt i dołącz do wiadomości e-mail
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108 | Poczta podrzędna_Skoroszyt()Application.DisplayAlerts = FalseApplication.enableevents = FałszApplication.ScreenUpdating = FałszApplication.Calculation = xlCalculationManualWygaś aplikację jako obiektWygaś pocztę jako obiektDim FilePath As StringDim nazwa_projektu jako ciągDim Nazwa_szablonu jako ciągDim Data recenzji jako ciągDim Zapisz lokalizację jako ciągPrzyciemnij ścieżkę jako ciągNazwa dim jako ciąg'Utwórz zmienne początkoweSet OutApp = CreateObject("Outlook.Application")Ustaw OutMail = OutApp.CreateItem(0)Nazwa_projektu = Arkusze("arkusz1").Range("NazwaProjektu").ValueNazwa_szablonu = Nazwa aktywnego arkusza„Zapytaj o dane wejściowe używane w wiadomości e-mail”ReviewDate = InputBox(Prompt:="Podaj datę, do której chcesz przesłać zgłoszenie do recenzji.", Title:="Wprowadź datę", Domyślnie:="MM/DD/RRRR")Jeśli ReviewDate = „Wprowadź datę” lub ReviewDate = vbNullString, a następnie przejdź do makra końcowego'Zapisz arkusz jako własny skoroszytŚcieżka = AktywnyKsiążka.ŚcieżkaName = Trim(Mid(ActiveSheet.Name, 4, 99))Ustaw ws = Aktywny arkuszUstaw oldWB = ThisWorkbookSaveLocation = InputBox(Prompt:="Wybierz nazwę pliku i lokalizację", Tytuł:="Zapisz jako", Default:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "/" & Nazwa & ". xlsx")Jeśli Dir(SaveLocation) „” ToMsgBox („Plik o tej nazwie już istnieje. Wybierz nową nazwę lub usuń istniejący plik.”)SaveLocation = InputBox(Prompt:="Wybierz nazwę pliku i lokalizację", Tytuł:="Zapisz jako", Default:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "/" & Nazwa & ". xlsx")Zakończ, jeśliJeśli SaveLocation = vbNullString Następnie przejdź do endmacro'w razie potrzeby usuń zabezpieczenie arkuszaActiveSheet.Unprotect Password:="hasło"Ustaw nowyWB = Skoroszyty.Dodaj'Dostosuj wyświetlaczAktywne okno.Zoom = 80ActiveWindow.DisplayGridlines = Fałsz„Kopiuj + wklej wartości”staryWB.AktywujstaryWB.ActiveSheet.Komórki.WybierzWybór.KopiujnowośćWB.AktywujnowośćWB.ActiveSheet.Komórki.WybierzSelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=Fałsz, Transpozycja:=FałszSelection.PasteSpecjalne wklejanie:=xlPasteFormaty, Operacja:=xlBrak, _SkipBlanks:=Fałsz, Transpozycja:=FałszSelection.PasteSpecjalne wklejanie:=xlPasteWalidacja, Operacja:=xlBrak, _SkipBlanks:=Fałsz, Transpozycja:=Fałsz'Wybierz nowy WB i wyłącz tryb wycinanianewWB.ActiveSheet.Range("A10").WybierzApplication.CutCopyMode = Fałsz'Zapisz pliknewWB.SaveAs Nazwa pliku:=Zapisz lokalizację, _FileFormat:=xlOpenXMLWorkbook, CreateBackup:=FalseFilePath = Application.ActiveWorkbook.FullName„Ponownie chroń stare WB”oldWB.ActiveSheet.Protect Password:="hasło", DrawingObjects:=True, Contents:=True, Scenariusze:=True _, AllowFormattingCells:=True, AllowFormattingColumns:=True, _AllowFormattingRows:=Prawda'E-mailPrzy błędzie Wznów DalejZ OutMail.to = "[email protected]".CC = "".BCC = "".Temat = Nazwa_projektu & ”: ” & Nazwa_szablonu & ” do przejrzenia”.Body = "Nazwa projektu: " & Nazwa_projektu & ", " & Nazwa & " Do sprawdzenia przez " & Data recenzji.Attachments.Add (Ścieżka pliku).Wyświetlacz' .Send ' Opcjonalnie, aby zautomatyzować wysyłanie wiadomości e-mail.Kończyć zW przypadku błędu Przejdź do 0Set OutMail = NicSet OutApp = Nic„Zakończ makro, przywróć aktualizację ekranu, obliczenia itp… endmacro:Application.DisplayAlerts = PrawdaApplication.enableevents = PrawdaApplication.ScreenUpdating = PrawdaAplikacja.Calculation = xlCalculationAutomaticNapis końcowy |
