Clever-Excel-Forum

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?

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..

(25.08.2022, 08:36)BuschB schrieb: [ -> ]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.

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^^

(25.08.2022, 11:17)BuschB schrieb: [ -> ]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:

Zitat: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)

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.

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^^

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.

BuschB

EarlFred

BuschB

EarlFred

BuschB

BuschB

EarlFred