Speichern als per UserForm / Letztes Blatt nicht drucken

[BuschB]

Ich versuch das grad ein wenig um zu setzen, aber ich stell mir grad die Frage, wie ich das am elegantesten löse, das ich mit verschiedenen Dateiendungen arbeite in den verschiedenen Speicherversionen und gerade beim Senden per Mail vor dem Problem stehe das ich das Dokument einmal zum Bearbeiten als .xlsm speichern muss und zum Versenden als .xlsx, ich aber nach dem senden nur die .xlsm auf der Festplatte behalten will...
probiere das gerade folgendermaßen:

Code:

Private Sub send_Click()
Dim strDateiname As String
    strDateiname = sp_name & ".xlsm"
If speicherDatei(strDateiname) = True Then
    strDateiname = sp_name & ".xlsx"
If speicherDatei(strDateiname) = True Then
With send_mail
    If .Visible = False Then
        .Show
    End If
End With
    Unload Me

End Sub

und

Code:

Private Sub send_Click()
    Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
Dim strZiel As String
    strZiel = ziel.Value
Dim strCC As String
    strCC = cc.Value
Dim strBetreff As String
    strBetreff = betreff.Value
Dim strNachricht As String
    strNachricht = nachricht.Value
If AktuelleArbeitsmappeSenden(strZiel, strBetreff, strCC, strNachricht) = True Then
    MsgBox "Erstellung der E-Mail erfolgreich"
    Sheets("Vorl. Blatt+").Visible = xlSheetVisible
Else
    MsgBox "Erstellung der E-Mail fehlgeschlagen!"
    Sheets("Vorl. Blatt+").Visible = xlSheetVisible
End If
    Kill (lw_pfad & sp_name & ".xlsx")
  
End Sub

habe aber angst das es mir die .xlsx löscht bevor sie mit der Mail abgeschickt ist... kann ich da irgendwas einbauen um da 100% sicher zu sein das das nicht passiert? ZB. wenn Outlook geschlossen wird... oder sowas?
Und vor allem, wie kann ich garantieren das die .xlsx versendet wird?

Code:

Function AktuelleArbeitsmappeSenden(strZiel As String, strBetreff As String, Optional strCC As String, Optional strNachricht As String) As Boolean
    On Error Resume Next
    Dim appOutlook As Object
    Dim meinElement As Object
    'Eine neue Instanz von Outlook erzeugen
    Set appOutlook = CreateObject("Outlook.Application")
    Set meinElement = appOutlook.CreateItem(0)
    With meinElement
        .To = strZiel
        .cc = strCC
        .Subject = strBetreff
        .Body = strNachricht
        .Attachments.Add ActiveWorkbook.FullName 'mit oder ohne Makro an NLS?
        'Verwenden Sie send, um sofort zu senden oder display, um auf dem Bildschirm anzuzeigen
        .Display 'oder .Send
    End With
    'Objekte aufräumen
    Set meinElement = Nothing
    Set appOutlook = Nothing
End Function

reicht da anstelle von "ActiveWorkbook.FullName" lw_pfad & sp_name & ".xlsx" zu schreiben?

Danke schonmal


PS:
Der Code für meine Speichern Funktion:

Code:

Function speicherDatei(ByVal wkb As Workbook, ByVal strDateiname As String) As Long
    sp_name = save_name.Value
    lw_pfad = save_path.Value
If sp_name = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
If lw_pfad = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
    Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
    If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
    Sheets("Blatt 1").Unprotect
    Sheets("Blatt 1").Range("DC12").Value = lw_pfad
    Sheets("Blatt 1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    Rem MsgBox lw_pfad
    wkb.SaveAs lw_pfad & strDateiname, 52
    MsgBox "Die Datei wurde unter " & lw_pfad & strDateiname & " gespeichert.", , "OK"
End If

End Function

bin mir sicher das ich da noch Fehler drin habe xD

[snb]

Selten braucht man Variabelen.

https://www.snb-vba.eu/VBA_Excelgegevens...ml#L_2.3.1

[BuschB]

Ok, ich sehe was du meinst, ich versuche das mal ein wenig zu reduzieren, da sich manches ja auch von selbst ergibt... Aber dennoch bleibt die Frage wie ich das temporäre Workbook wieder los werde nachdem ich es per Mail versendet habe. Ich mein mit Kill geht das sicher recht gut, aber wie kann ich sicher gehen, das der Befehl erst ausgeführt wird wenn die Mail abgeschickt ist? Kann ich irgendwie in VBA auslesen wenn eine bestimmte Mail in "Gesendet" auftaucht?

[BuschB]

Kleines Nebenproblem:

Code:

Private Sub send_Click()
Dim strDateiname As String
    strDateiname = save_name.Value & ".xlsm"
If speicherDatei(strDateiname) = True Then
    Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
    strDateiname = save_name.Value & ".xlsx"
If speicherDatei(strDateiname) = True Then
With send_mail
    If .Visible = False Then
        .Show
    End If
End With
End If

End Sub

hier beschwert er sich das bei "If speicher Datei(strDateiname) = True Then" die Typen unverträglich wären, markiert mir in dem Zusammenhang strDateiname
Hab ich da irgendwas missverstanden oder einen Fehler gemacht bei dem Versuch Variablen zu sparen?

[Steffl]

Hallo,

Kleines Nebenproblem:

Code:

If speicherDatei(strDateiname) = True Then

hier beschwert er sich das bei "If speicher Datei(strDateiname) = True Then" die Typen unverträglich wären, markiert mir in dem Zusammenhang strDateiname
Hab ich da irgendwas missverstanden oder einen Fehler gemacht bei dem Versuch Variablen zu sparen?

Du verwendest auch unterschiedliche Variablentypen

Der Code für meine Speichern Funktion:

Code:

Function speicherDatei(ByVal wkb As Workbook, ByVal strDateiname As String) As Long

bin mir sicher das ich da noch Fehler drin habe xD

Einmal Wahrheitsweert einmal ein Zahlwert

[BuschB]

Eigentlich eher ein Textwert... was aber bei dem Code in der Send Funktion zuvor noch funktionierte... Wie dem auch sein, weglassen kann ich die strDateiname auch nicht, dann beschwert er sich nämlich das die Variable nicht Optional ist oder so... xD

[Steffl]

Hallo,

sorry, ich habe übersehen, das die Funktion SpeicherDatei zwei Parameter verlangt.

versuche es mal so

Code:

If speicherDatei(ActiveWorkbook, strDateiname) = True Then

[schauan]

Hallöchen,

wie ist denn eigentlich die Beziehung zwischen den Blättern und dem wkb? Wenn die n dem wkb drin sind, wäre es nicht verkehrt, wenn das im Code auch umgesetzt wird, also statt

Code:

Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
    If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
    Sheets("Blatt 1").Unprotect
    Sheets("Blatt 1").Range("DC12").Value = lw_pfad
    Sheets("Blatt 1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    Rem MsgBox lw_pfad
    wkb.SaveAs lw_pfad & strDateiname, 52

dann vielleicht

Code:

With wkb
    .Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
    If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
    With .Sheets("Blatt 1")
        .Unprotect
        .Range("DC12").Value = lw_pfad
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
        Rem MsgBox lw_pfad
   End With
   .SaveAs lw_pfad & strDateiname, 52
End With

[BuschB]

Oh ja, das geht, Fehlermeldung ist weg, danke^^
Aber dafür scheint die Speichern Funktion nicht zu gehen:

Code:

Private Sub cancel_Click()
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Sheets("Vorl. Blatt+").Visible = xlSheetVisible
    Unload Me
End Sub

Private Sub finished_Click()
Dim strDateiname As String
    Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
    strDateiname = save_name.Value & ".xlsx"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
    Kill (save_path.Value & save_name.Value & ".xlsm")
    Unload Me
End If

End Sub

Private Sub send_Click()
Dim strDateiname As String
    strDateiname = save_name.Value & ".xlsm"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
    Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
    strDateiname = save_name.Value & ".xlsx"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
With send_mail
    If .Visible = False Then
        .Show
    End If
End With
End If
End If

End Sub

Private Sub UserForm_Initialize()
    save_name.Value = "Schaltprogramm " & ActiveSheet.Range("C12").Value & ActiveSheet.Range("I12").Value & ActiveSheet.Range("O12").Value & ActiveSheet.Range("U12").Value & ActiveSheet.Range("AA12").Value & ActiveSheet.Range("AG12").Value & ActiveSheet.Range("AM12").Value & ActiveSheet.Range("AS12").Value & ActiveSheet.Range("AY12").Value & ActiveSheet.Range("BE12").Value
    save_path.Value = Sheets("Blatt 1").Range("DC12").Value
   
End Sub

Private Sub work_in_progress_Click()
Dim strDateiname As String
    strDateiname = save_name.Value & ".xlsm"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
    Unload Me
End If

End Sub

Function speicherDatei(ByVal wkb As Workbook, ByVal strDateiname As String) As Long
If save_name.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
If save_path.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
    If Right(save_path.Value, 1) <> "\" Then save_path.Value = save_path.Value & "\"
    Sheets("Blatt 1").Unprotect
    Sheets("Blatt 1").Range("DC12").Value = save_path.Value
    Sheets("Blatt 1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    Rem MsgBox save_path.Value
    wkb.SaveAs save_path.Value & strDateiname, 52
    MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If

End Function

Cancel funktioniert, aber bei jedem anderen Button rührt sich nichts, Ich seh aber gerade nicht was ich da vllt vergessen habe... (und hab auch leider gerade keine Zeit mehr, Feierabend und so xD) falls da jemand nen fachlich begabteren Blick drüber werfen könnte und möglicherweise etwas sieht was ich nicht sehe...?

[schauan]

Hallöchen,

Aber dafür scheint die Speichern Funktion nicht zu gehen:

- passiert dabei gar nix?
- kommt eine Fehlermeldung?
- wird die Funktion bei schrittweisem Durchlauf komplett durchlaufen?
- passen die Inhalte der Variablen bzw. der abgefragten Objekte?