---

Hallo Freunde,
schöne Grüße aus dem Ruhestand     

Nach längerer Zeit bastle ich gerade mal wieder an einem kleinen Progrämmchen, das u.a. mein aktuelle Modell in verschiedenen Formaten speichern soll.
Gundsätzlich kein Problem, das Programm läuft (fast) wie es soll.

Allerdings ist mir jetzt doch was aufgefallen: Wenn die zu speichernde Datei bereits existiert und z.B. durch ein anderes Programm gesperrt ist, kann sie ja nicht überschrieben werden.
Die verschiedenen Varianten von SaveAs aus der SWX-API merken das aber offfenbar nicht, die geben mir immer einen Erfolg zurück.
Beispiel:
               

Code:

---

boolstatus = swModExt.SaveAs(filename & "." & Format,
                                            swSaveAsVersion_e.swSaveAsCurrentVersion,
                                            swSaveAsOptions_e.swSaveAsOptions_Silent,
                                            Nothing, errors, warnings)

---

boolstatus ist immer true, auch errors und warnings sind immer 0, obwohl die Datei gesperrt ist und definitiv nicht überschrieben wird.
Das selbe gilt auch für modeldoc2.SaveAs3() und andere Varianten.
Mach ich was falsch? Wie kann ich das Problem abfangen?
Ich hab das schon so oft verwendet in meiner aktiven Zeit, das ist mir aber noch nie aufgefallen.

------------------
Klaus

es war einmal bei http://www.alko-tech.com | mein Gästebuch

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Klaus,
ich habe da in meinen Makros eine Abfrage drinnen, ob die Datei bereits existiert und evtl. in Verwendung ist.
Ich komme momentan aber nicht an meine Makros ran, da ich zu Hause keine Lizenz mehr habe.
Ich kann morgen mal im Geschäft schauen, und dir hier was posten.

Grüße, Andi 

------------------
Hast du kein Problem?
Such dir eins. ( Und löse es )

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

und hier die Lösung:

Code:

---

Sub berSfPDFspeichern()
  If FileExists(saveFileName) = True Then                    ' prüfen, ob die Datei existiert
            If IsFileOpen(saveFileName) = True Then                ' ob die Datei bereits von einem Benutzer geöffnet ist
                Call MsgBox(saveFileName & vbCrLf & "Datei wird bereits verwendet", vbSystemModal, "Information")
                Exit Sub
            Else
                'Call MsgBox(saveFileName & vbCrLf & "Datei wird nicht verwendet", vbSystemModal, "Information")
            End If
       
            If berSchreibgeschuetzt(saveFileName) = True Then      ' prüfen, ob die Datei schreibgeschützt ist
                'Call MsgBox(saveFileName & vbCrLf & "ist schreibgeschützt", vbSystemModal, "Information")
                Exit Sub                                            ' die Datei ist schreibgeschützt, lieber nicht speichern
            End If
        End If
End Sub

Private Function FileExists(filename As String) As Boolean  'aus Makro savequalitybitmap von Stefan Berlitz
    ' prüfen, ob Datei FileName existiert
    Dim intLen As Integer

    If filename <> vbNullString Then
      On Error Resume Next
      intLen = Len(Dir$(filename))
      On Error GoTo 0
      FileExists = (Not Err And intLen > 0)    'True = existiert, False = existiert nicht
    Else
      FileExists = False                        'Datei strDest existiert nicht
    End If
 
End Function

Private Function IsFileOpen(filename As String) As Boolean    'https://support.microsoft.com/de-de/help/291295/macro-code-to-check-whether-a-file-is-already-open
    Dim filenum    As Integer
    Dim errnum      As Integer

    On Error Resume Next  ' Turn error checking off.              Deaktivieren Sie die Fehlerüberprüfung.
    filenum = FreeFile()  ' Get a free file number.                Holen Sie sich eine freie Dateinummer.
    ' Attempt to open the file and lock it.                        Versuchen Sie, die Datei zu öffnen und zu sperren.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.                        Schließen Sie die Datei.
    errnum = Err          ' Save the error number that occurred.  Speichern Sie die aufgetretene Fehlernummer.
    On Error GoTo 0        ' Turn error checking back on.          Schalten Sie die Fehlerprüfung wieder ein.

    ' Check to see which error occurred.                            Überprüfen Sie, welcher Fehler aufgetreten ist.
    Select Case errnum

        ' No error occurred.                                        Es ist kein Fehler aufgetreten.
        ' File is NOT already open by another user.                Datei ist NICHT bereits von einem anderen Benutzer geöffnet.
        Case 0
            IsFileOpen = False

        ' Error number for "Permission Denied."                    Fehlernummer für "Berechtigung verweigert"
        ' File is already opened by another user.                  Datei ist bereits von einem anderen Benutzer geöffnet.
        Case 70
            IsFileOpen = True

        ' Another error occurred.                                  Ein anderer Fehler ist aufgetreten.
        Case Else
            Error errnum
    End Select

End Function

Private Function berSchreibgeschuetzt(filename As String) As Boolean

' https://www.tutorials.de/threads/dateien-auf-schreibschutz-pruefen.76789/

    Dim fso As FileSystemObject
    Dim f  As File
   
    Set fso = New FileSystemObject
    Set f = fso.GetFile(filename)
   
    If (f.Attributes And ReadOnly) = ReadOnly Then
        berSchreibgeschuetzt = True
        Call MsgBox(filename & vbCrLf & "ist schreibgeschützt", vbSystemModal, "Information")    ' Anzeige des kpl. Pfades incl. Dateinamen und Extender
    Else
        berSchreibgeschuetzt = False
    End If
   
    'Objekte freigeben
    Set f = Nothing
    Set fso = Nothing
   
End Function

---

Ich hoffe der Code ist komplett.

Viel Erfolg
Grüße Andi 

------------------
Hast du kein Problem?
Such dir eins. ( Und löse es )

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP