Thema: Reiter > Export als Datei + Versand per Mail

Servus zusammen, ich habe eine Kalkulationsdatei mit 2 Reitern.

Reiter 1 Name > Expert
Reiter 2 Name > Export

Die Daten die im Reiter Export sind sollen in einem neuen Tabellenblatt gespeichert werden (ohne das Steuerelement welches ich dafür nutze)
Und nach dem speichern soll direkt eine Mail versendet werden. Ich nutze aktuell 2 Schritte dafür

Makro 1 > Einzelblatt speichern (das Steuerelement wird leider mit gespeichert)
Makro 2 > Mail versand

Hier die beiden Codes:

Makro 1:

Sub EinzelnesBlattSpeichern()
Application.ScreenUpdating = False
On Error GoTo Fehler
ActiveSheet.Copy
Dim neuName As String
neuName = InputBox("Unter welchem Namen soll die Datei gespeichert werden?")
ActiveWorkbook.SaveAs Filename:="C:\Max\" & neuName & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
MsgBox " Die Datei wurde unter C:\Max\" & neuName & " gespeichert !", vbibformation
Application.ScreenUpdating = True
Exit Sub
Fehler: MsgBox "Fehler bei Datei speichern aufgetreten!"
End Sub

Makro 2:

Sub EmailManuellAbsenden()

Dim objOutlook As Object
Dim objMail As Object

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
.To = "info@web.de"
.Subject = "Auftrag "
.Body = "Hi SDL Auftrag, please book the order"
.Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!
End With

' Display a custom message
MsgBox "SDL Auftrag export completed successfully!" & vbCr & vbCr & "Thank You", vbInformation

End Sub

Meine konkrete Frage. Wie kann ich das über EIN Makro machen?

> Also speichern ohne Steuerelement + neuen Name vergeben und dann direkt die neue Datei als Anhang per Mail versenden?

Vielleicht hat jemand eine Idee.. DANKE
VG Max

Hallo Max,
Du hast doch nicht etwa vergessen zu googeln???
Siehe:
https://www.herber.de/forum/archiv/940to944/942478_Tabellenblatt_via_Email_verschicken_und_speichern.html
Gruß
Jochen

Danke Jochen.

Wie kann ich hier noch eintragen, dass nicht das aktive Sheet genommen werden soll sondern nur das Sheet "Export" ?

Sub MailSenden()
Application.ScreenUpdating = False
On Error Resume Next
Dim empfänger As String
Dim i As Integer
Dim aws As String
Dim olapp As Object
For i = 1 To 50
Sheets(i).Activate
empfänger = Sheets(i).Range("C3").Value
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs ActiveSheet.Name
aws = ActiveWorkbook.FullName

Max,
Du musst den Code für Dich anpassen, z.B. nur für das Blatt "Export"; also ohne die Schleife "1 to 50"

Option Explicit



Sub MailSenden()

  Application.ScreenUpdating = False

  On Error Resume Next

  Dim empfaenger As String

  Dim i As Integer

  Dim aws As String

  Dim olapp As Object

  empfaenger = "dein.empfaenger@xxx.de"

  ActiveWorkbook.Sheets("Export").Copy

  ActiveWorkbook.SaveAs ActiveSheet.Name

  aws = ActiveWorkbook.FullName

  Set olapp = CreateObject("Outlook.Application")

  With olapp.CreateItem(0)

    .To = empfaenger

    .Subject = "Dein Text " & Date

    .HtmlBody = "Dein Anschreiben im Mail-Body"

    .attachments.Add aws

    .Display

    'SendKeys "%s", True 'Mail sofort senden

    ActiveWorkbook.Close

    Set olapp = Nothing

  End With

  Sheets(1).Activate

  Application.ScreenUpdating = True

End Sub

Gruß
Jochen

Jochen, danke, cool. Könntest du mir bitte noch sagen wie ich die InputBox noch reinbekomme damit ich einen individuellen Namen eingeben kann? Ich hatte dieses Makro bereits integriert:

Sub EinzelnesBlattSpeichern()
Application.ScreenUpdating = False
On Error GoTo Fehler
ActiveSheet.Copy
Dim neuName As String
neuName = InputBox("Unter welchem Namen soll die Datei gespeichert werden?")
ActiveWorkbook.SaveAs Filename:="C:\Sony\" & neuName & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
MsgBox " Die Datei wurde unter C:\Sony\" & neuName & " gespeichert !", vbibformation
Application.ScreenUpdating = True
Exit Sub

Nach dieser Input Box soll dann die Mail gesendet werden wie bereits von Dir geschickt.

so:

Option Explicit



Sub MailSenden()

  Application.ScreenUpdating = False

  On Error Resume Next

  Dim empfaenger As String

  Dim i As Integer

  Dim aws As String

  Dim awsSheet As String

  Dim olapp As Object

  awsSheet = InputBox("Unter welchem Namen soll die Datei gespeichert werden?")

  ActiveWorkbook.SaveAs Filename:="C:\Sony\" & neuName & ".xls"

  empfaenger = "dein.empfaenger@xxx.de"

  ActiveWorkbook.Sheets(awsSheet).Copy

  ActiveWorkbook.SaveAs Filename:="C:\Sony\" & awsSheet & ".xls"

  aws = ActiveWorkbook.FullName

  Set olapp = CreateObject("Outlook.Application")

  With olapp.CreateItem(0)

    .To = empfaenger

    .Subject = "Dein Text " & Date

    .HtmlBody = "Dein Anschreiben im Mail-Body"

    .attachments.Add aws

    .Display

    'SendKeys "%s", True 'Mail sofort senden

    ActiveWorkbook.Close

    Set olapp = Nothing

  End With

  Sheets(1).Activate

  Application.ScreenUpdating = True

End Sub

Jochen

Danke Jochen, aber exportiert wird alles. Ich brauche nur den Reiter "Export"

Ausserdem wird die Datei inkl. Blattschutz Passwort exportiert, kannst Du das bitte so hinterlegen dass dieser bei der neuen Datei entfällt?

DAS WÄRE SUPER!! DANKE

Hallo Max,
also so?

Option Explicit



Sub MailSenden()

  

  Application.ScreenUpdating = False

  Dim empfaenger As String

  Dim neuName As String

  Dim expSheet As String

  Dim olapp As Object

  

  'um welches Tabellenbaltt geht es

  expSheet = InputBox("Welches Blatt soll versandt und gespeichert werden??")

  ActiveWorkbook.Sheets(expSheet).Copy

  

  'unter welchem Dateinamen soll die neue Arbeitsmappe gespeicgert werden

  neuName = InputBox("Unter welchem Namen soll die Datei gespeichert werden?")

  ActiveWorkbook.SaveAs fileNAme:="C:\Sony\" & neuName & ".xls", FileFormat:=xlNormal, _

    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

  

  'wie lautet die Zieladresse (Mail)

  empfaenger = "dein.empfaenger@xxx.de"



  'Outlook starten und Mail mit Anhang erstellen

  Set olapp = CreateObject("Outlook.Application")

  With olapp.CreateItem(0)

    .To = empfaenger

    .Subject = "Dein Text " & Date

    .HtmlBody = "Dein Anschreiben im Mail-Body"

    .attachments.Add ActiveWorkbook.FullName

    .Display

    'SendKeys "%s", True 'Mail sofort senden

    Set olapp = Nothing

  End With

  

  Set olapp = Nothing

  

  ActiveWorkbook.Close

  Sheets(1).Activate

  Application.ScreenUpdating = True



End Sub

Gruß
Jochen

Hi Jochen, fast, bitte ganz konkret Reiter "Export"

Es muss nicht nach dem Reiter gefragt werden der gespeichert werden soll. Es ist immer allein und ausschließlich Reiter "Export"

Das wär superlieb
Danke

Eieiei,
soooo schwierig wär das nun aber wirklich nicht gewesen:

Option Explicit



Sub MailSenden()

  

  Application.ScreenUpdating = False

  Dim empfaenger As String

  Dim neuName As String

  Dim expSheet As String

  Dim olapp As Object

  

  'um welches Tabellenbaltt geht es

     'expSheet = InputBox("Welches Blatt soll versandt und gespeichert werden??")

     'ActiveWorkbook.Sheets(expSheet).Copy

  ActiveWorkbook.Sheets("Export").Copy

  

  'unter welchem Dateinamen soll die neue Arbeitsmappe gespeicgert werden

  neuName = InputBox("Unter welchem Namen soll die Datei gespeichert werden?")

  ActiveWorkbook.SaveAs fileNAme:="C:\Sony\" & neuName & ".xls", FileFormat:=xlNormal, _

    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

  'ActiveWorkbook.SaveAs fileNAme:="G:\Mein Excel\Herbers Excel-Forum\Max_02052024\" & _

    neuName & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", _

    ReadOnlyRecommended:=False, CreateBackup:=False

    

  'wie lautet die Zieladresse (Mail)

  empfaenger = "dein.empfaenger@xxx.de"



  'Outlook starten und Mail mit Anhang erstellen

  Set olapp = CreateObject("Outlook.Application")

  With olapp.CreateItem(0)

    .To = empfaenger

    .Subject = "Dein Text " & Date

    .HtmlBody = "Dein Anschreiben im Mail-Body"

    .attachments.Add ActiveWorkbook.FullName

    .Display

    'SendKeys "%s", True 'Mail sofort senden

    Set olapp = Nothing

  End With

  

  Set olapp = Nothing

  

  ActiveWorkbook.Close

  Sheets(1).Activate

  Application.ScreenUpdating = True



End Sub

Jochen

Danke Jochen. Aber wenn man halt keinen Plan von VBA hat ist es nun mal schwierig..

Es funzt jetzt. DANKE!

Gerne, schönes WE