ich benötige wieder mal euere Hilfe.
Ich habe eine Datei mit dem Namen "Hobby.xlsm". Diese Datei enthält mehrere Tabellenblätter und das original liegt auf Teams/Sharepoint. Jetzt möchte über einen VBA Code erreichen, dass beim schließen der Datei "Hobby.xlsm" folgendes passiert.
1. für jedes Tabellenblatt der Blattschutz aktiviert und ein Passwort gesetzt wird. Alle Tabellenblätter sollen das gleiche Passwort bekommen.
2. Soll überprüft werden in welchem Laufwerk/Pfad sich die geöffnete Datei "Hobby.xlsm" befindet.
2.1 Befindet sich Datei "Hobby.xlsm" im Laufwerk/Pfad A: (Teams/Sharepoint), dann prüfen ob zusätzlich auch eine aktive Verbindung zum Netz-Laufwerk/Pfad B: besteht.
a) es besteht keine Verbindung zum Netz-Laufwerk/Pfad B:/Test, dann nur im Laufwerk/Pfad A: (Teams/Sharepoint) speichern und schließen
b) es besteht eine Verbindung zum Netz-Laufwerk B:/Test, dann soll zum einen die Datei "Hobby.xlsm" in Laufwerk/Pfad A: (Teams/Sharepoint) gespeichert werden und gleichzeitig eine Kopie mit dem Namen "Kopie_Hobby.xlsx" im Laufwerk/Pfad B:/Test abgelegt werden. Und die Datei soll geschlossen werden.
Bisher habe ich folgendes versucht:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim xSheet As Worksheet
Dim xPsw As String
xPsw = "GEHEIM"
For Each xSheet In Worksheets
xSheet.Protect xPsw
Next
Const FOLDER_PATH As String = "B:\Test"
If Not Saved Then
Select Case MsgBox("Sollen Ihre Änderungen in B:\Test\ Kopie_ '" & Name & _"' gespeichert werden", vbExclamation Or vbYesNoCancel)
Case vbYes
Save
Case vbNo
Saved = True
Case vbCancel
Cancel = True
End Select
End If
If Not Cancel Or No Then
If Dir$(FOLDER_PATH, vbDirectory) vbNullString Then
Application.DisplayAlerts = False
Call SaveAs(Filename:="B:\Test\" & "Kopie_" & Left$(Name, InStrRev(Name, ".")) & "xlsx", _
FileFormat:=xlOpenXMLWorkbook, WriteResPassword:="GEHEIM")
Application.DisplayAlerts = True
End If
End If
End Sub
Aber leider gibt es hier immer wieder Probleme beim speichern. Hat hier jemand eine Idee, wie ich das besser gestalten kann?Grüße,
Martin