Speicherfunktion läuft problemlos, gibt trotzdem False zurück

[BuschB]

Ich habe hier ein kleines Problem mit meinem Code:

Code:

Code:

If speicherDatei(ActiveWorkbook, strDateiname) = True Then

gibt wohl immer False zurück  aber ich weiß nicht warum, was gib in dieser Funktion:

Code:

Code:

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
Else
If save_path.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
    checkname = Dir("*" & wbkname & "*")
If checkname <> "" Then
    If checkname <> save_name.Value Then
        datei_exist.Show
        If Sheets("Blatt 1").Range("DB12").Value = "1" Then
            Unload Me
            Exit Function
        End If
    End If
End If
With wkb
    If Right(save_path.Value, 1) <> "\" Then save_path.Value = save_path.Value & "\"
    With .Sheets("Blatt 1")
        .Unprotect
        .Range("DB12").ClearContents
        .Range("DC12").Value = save_path.Value
        .Range("DD12").Value = save_name.Value
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
        Rem MsgBox save_path.Value
    End With
    .SaveAs save_path.Value & strDateiname
End With
    MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If

End Function

False zurück? (muss dazu auch erwähnen das es schonmal funktioniert hatte, bevor ich die Variablen reduziert hab, das Speichern selbst funktioniert auch weiterhin, es kommt halt nur an irgendeiner Stelle ein False)
Und Frage zwei lautet:
Warum bleibt checkname immer leer, scannt Dir nicht in Netzwerklaufwerken des lokalen Firmen Netzwerks? (das checkname und die Dir Funktion sind auch eher nebensächlich, kann das auch weglassen da wir zum Glück nicht so viel haben das wir da nicht auch mal selbst schauen können)

Hoffe ihr hab dafür Ideen und Lösungen?

[26865]

Was sind denn 
- save_name
- save_path
- wbkname
- checkname
- datei_exist?
Ich finde nirgends eine Deklaration und Wertzuweisung. Könnte das relevant sein?

Wenn die Function True oder False zurückgeben soll, sollte sie als BOOLEAN deklariert sein, nicht als Long. 

Und irgendwo, wo du den Erfolg des Speicherns festgestellt hast (also nach .SaveAs save_path.Value & strDateiname), müsste dann speicherDatei = True stehen..

---

Warum bleibt checkname immer leer, scannt Dir nicht in Netzwerklaufwerken des lokalen Firmen Netzwerks?

Dafür müsste man sehen, wo und welchen Wert wbkname bekommt.

[BuschB]

Ok, dann hier mal der gesamte Code...
UserForm save_as:

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()
    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()
    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
    Unload Me
End If
End If

End Sub

Private Sub UserForm_Initialize()
    wbkname = 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
If Sheets("Blatt 1").Range("DD12").Value <> "" Then
    save_name.Value = Sheets("Blatt 1").Range("DD12").Value
Else
    save_name.Value = "Schaltprogramm " & wbkname & Sheets("Blatt 1").Range("AF20").Value & Sheets("Blatt 1").Range("AF22").Value
End If
   
End Sub

Private Sub work_in_progress_Click()
    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
Else
If save_path.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
With wkb
    If Right(save_path.Value, 1) <> "\" Then save_path.Value = save_path.Value & "\"
    With .Sheets("Blatt 1")
        .Unprotect
        .Range("DB12").ClearContents
        .Range("DC12").Value = save_path.Value
        .Range("DD12").Value = save_name.Value
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    End With
    .SaveAs save_path.Value & strDateiname
End With
    MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If

End Function

UserForm send_mail:

Code:

Private Sub cancel_Click()
    With save_as
        If .Visible = False Then
            .Show
        End If
    End With
    Unload Me
   
End Sub

Private Sub send_Click()
If AktuelleArbeitsmappeSenden() = True Then
    MsgBox "Erstellung der E-Mail erfolgreich"
Else
    MsgBox "Erstellung der E-Mail fehlgeschlagen!"
End If
    'Kill (lw_path & wbkname & ".xlsx")
   
End Sub

Private Sub UserForm_Initialize()
    ziel.Value = ""
    cc.Value = ""
    betreff.Value = save_as.save_name.Value
    nachricht.Value = ""
   
End Sub

Function AktuelleArbeitsmappeSenden() 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 = ziel.Value
        .cc = cc.Value
        .Subject = betreff.Value
        .Body = nachricht.Value
        .Attachments.Add save_as.save_path.Value & save_as.save_name.Value & ".xlsx"
        '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

Und die genutzten Variablen im eigenen Modul:

Code:

Public wbkname As String
Public strDateiname As String

Das ganze getriggert durch:

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
With save_as
    If .Visible = False Then
        .Show
    End If
End With

End Sub

Private Sub Workbook_BeforePrint(cancel As Boolean)
    Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden

End Sub

in der Arbeitsmappe...
Hoffe jetzt kannst du leichter erkennen was ich meine... Das mit Boolean anstelle von Long kann ich mal ausprobieren, habe den Code für die Funktion aber im groben so gefunden und nur an meine Zwecke angepasst...hatte zuvor auch mal funktioniert trotz Long, aber ich probiere es mal aus und gebe dann nochmal Rückmeldung^^

[26865]

hatte zuvor auch mal funktioniert trotz Long, aber ich probiere es mal aus und gebe dann nochmal Rückmeldung^^

Ja, auch Long kann das Ergebnis einer boolschen Operation aufnehmen, hat dann aber nicht den Wert True oder False sondern -1 oder 0. Dennoch: Erwartest du einen boolschen Ausdruck, verwende eine boolsche Variable. 

Den anderen Tipp probierst du bitte auch erstmal aus, bevor ich mich durch deinen restlichen Code wurschtele:

Und irgendwo, wo du den Erfolg des Speicherns festgestellt hast (also nach .SaveAs save_path.Value & strDateiname), müsste dann speicherDatei = True stehen..

Solange du der Function speicherDatei nicht einen Rückgabewert zuweist, liefert sie den Defaultwert des Variablentyps des Rückgabewerts der Function. Bei Long ist das 0, bei einer boolschen Variable False. Beides wird als Falsch interpretiert (siehe Absatz zuvor)

[BuschB]

Ah ok, ich muss das also manuell ausgeben, jetzt verstehe ich das Prinzip, super, dann änder ich das gleich, lass es mal durch laufen und schau was passiert.

[BuschB]

Alles klar, vielen Dank, jetzt Funktioniert es wunderbar, kann ich also mit den nächsten Schwierigkeiten weiter machen:
Ich hab hier im save_as:

Code:

Option Explicit
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()
    Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
    strDateiname = save_name.Value & ".xls"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
    Kill (save_path.Value & save_name.Value & ".xlsm")
    Unload Me
End If

End Sub

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

End Sub

Private Sub UserForm_Initialize()
    wbkname = 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
If Sheets("Blatt 1").Range("DD12").Value <> "" Then
    save_name.Value = Sheets("Blatt 1").Range("DD12").Value
Else
    save_name.Value = "Schaltprogramm " & wbkname & " " & Sheets("Blatt 1").Range("AF20").Value & " " & Sheets("Blatt 1").Range("AF22").Value
End If
   
End Sub

Private Sub work_in_progress_Click()
    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 Boolean
If save_name.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
If save_path.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
    checkname = Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly)
If checkname <> "" Then
    If checkname <> save_name.Value & ".xls" Then
        If checkname <> save_name.Value & ".xlsm" Then
            datei_exist.Show
            If Sheets("Blatt 1").Range("DB12").Value = "1" Then
                Unload Me
                Exit Function
            End If
        End If
    End If
End If
With wkb
    If Right(save_path.Value, 1) <> "\" Then save_path.Value = save_path.Value & "\"
    With .Sheets("Blatt 1")
        .Unprotect
        .Range("DB12").ClearContents
        .Range("DC12").Value = save_path.Value
        .Range("DD12").Value = save_name.Value
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    End With
    .SaveAs save_path.Value & strDateiname
End With
    speicherDatei = True
    MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If

End Function

eine Dir eingebaut die mir in einer anderen UserForm, datei_exist:

Code:

Option Explicit
Private Sub datno_Click()
    With ActiveWorkbook.Sheets("Blatt 1")
        .Unprotect
        .Range("DB12").Value = 1
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    End With
    With save_as
        If .Visible = False Then
            .Show
        End If
    End With
    Unload Me
   
End Sub

Private Sub datverg_Click()
    Dim ergebnis
    Dim aufruf As String
        aufruf = "cmd " & DatName.Value
        ergebnis = Shell(aufruf, vbNormalFocus)
        MsgBox ergebnis & "zum Vergleich geöffnet."
    Next

End Sub

Private Sub datyes_Click()
'    Kill (checkname)
    Unload Me

End Sub

Private Sub UserForm_Initialize()
    DatNr.Value = wbkname
With DatName
    .Clear
    .ColumnCount = 10
    .List = checkname
End With

End Sub

bereits existierende Dateien mit derselben Dokumentennummer im Namen auflisten soll und mir die Optionen zur Verfügung stellen soll:
Die Dateien zu öffnen und zu Vergleichen.
Sowie:
  Die Dateien zu löschen und die Speicherfunktion fort zu setzen.
  Oder:
  Die Daten zu behalten und den gesamten Speichervorgang vollständig ab zu brechen, auch das Speichern welches Initial das save_as triggert:

Code:

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
With save_as
    If .Visible = False Then
        .Show
    End If
End With

End Sub

Private Sub Workbook_BeforePrint(cancel As Boolean)
    Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden

End Sub

Momentan ist es aber noch nicht dazu in der Lage die Dateien in der ListBox DatName zu zeigen, geschweige denn sie zu öffnen, hat da jemand eine Idee was ich vergessen habe, wo mein Fehler liegt?

Danke schonmal^^

[26865]

Mit deiner Userform hast du doch in deinem anderen Thread schon Hundertschaften an Helfern über unzählige Seiten beschäftigt. Das musst du hier nicht auch weiter ausarten lassen. 

Ich erachte die Frage, um die es ging, als beantwortet.