Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1848to1852
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Automatische Kopie, Laufwerk abhängig

Automatische Kopie, Laufwerk abhängig
29.09.2021 12:30:24
Martin
Hallo zusammen,
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatische Kopie, Laufwerk abhängig
01.10.2021 10:30:08
Yal
Moin MArtin,
versuche folgendes:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim xSheet As Worksheet
Dim msg As String
Const xPsw = "GEHEIM"
Const FOLDER_PATH As String = "B:\Test"
Application.DisplayAlerts = False
'Alle Blätter schutzen
For Each xSheet In Worksheets
xSheet.Protect xPsw
Next
'"If Not Saved Then" brauchst Du nicht: durch "Alle Blätter schutzen" hast Du ein Zustandsänderung: "Saved" ist false
msg = "Sollen Ihre Änderungen in B:\Test\ Kopie_ '" & Name & "' gespeichert werden"
Select Case MsgBox(msg, vbExclamation + vbYesNoCancel)
Case vbCancel
Cancel = True
Case vbNo
ThisWorkbook.Saved = True
Case vbYes
ThisWorkbook.Save
If Dir$(FOLDER_PATH, vbDirectory)  vbNullString Then
SaveCopyAs _
Filename:="B:\Test\" & "Kopie_" & Left$(Name, InStrRev(Name, ".")) & "xlsx", _
FileFormat:=xlOpenXMLWorkbook, _
WriteResPassword:=xPsw
End If
End Select
Application.DisplayAlerts = True
End Sub
ungetestet.
VG
Yal
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige