AW: Dat. kopieren und versch.Namen speicher
09.03.2023 10:51:36
Yal
Hallo Severine,
da wo die Dateiname als Verkettung von Einzelteile zusammengebaut wird kommt der Punkt daziwschen:
DateiName = Split(ThisWorkbook.Name, ".")(0) & Trim(Z.Value) & "." & Split(ThisWorkbook.Name, ".")(1)
Bei der Beschreibung musst Du -fast- genauso stumpf, wie einen Rechner sein. Was haben wir:
_ eine Datei, bzw. Arbeitsmappe, bei dem der Code liegt. Das ist "ThisWorkbook" (es müsste, wenn ich es richtig verstehe, die Datei mit der Liste sein. "C:\Users\r5479\Desktop\BÜ-Tool\BÜ-Bearbeitung\MitarbeiterListe.xlsm" )
_ eine abgelgte Kopie, was uns nicht besonders kümmert: wir sagen nur, wo und mit welcher Name
_ eine Datei der als Vorlage für die Kopie gilt. Ich habe bisher angenommen, es handelt sich um "ThisWorbook", aber anscheinend nicht.
Ich schlage folgende Variante vor:
Sub DateiAlsNeue_speichern() ' sprechende Name
'Unter Anbindung der Biliothek "Micosoft Scripting Runtime" (in VB, "Extras", "Verweise...", haken bei der Bib
Dim FSO As New FileSystemObject 'aus der Bib Scripting Runtime
Dim Z As Range 'Z wei Zelle
Dim Dateiname As String
Dim DateiExt As String
Dim ZielDateiname As String
Dim wbVorlage As Workbook
'die "Dim" werden immer am Anfang aufgelistet. Es ist nur eine Deklaration. Instanziert werden sie nur bei Bedarf
'dann die Const
Const cZielOrdner = "C:\Users\r5479\Desktop\BÜ-Tool\"
'Vorlage öffnen
Set wbVorlage = Workbook_holen(cZielOrdner & "BÜ-Bearbeitung\BÜ-Tool-Bearbeitung.xlsm")
Dateiname = Split(wbVorlage.Name, ".")(0)
DateiExt = Split(wbVorlage.Name, ".")(1)
'Prüfe ob Datei bereits vorliegt:
With Worksheets("Tabelle1") 'Anpassen
For Each Z In Range(.Range("A1"), .Cells(Rows.Count, "A").End(xlUp)) 'für jedes Element in Spalte A
ZielDateiname = Dateiname & Trim(Z.Value) & "." & DateiExt
If Not FSO.FileExists(cZielOrdner & ZielDateiname) Then
wbVorlage.SaveCopyAs cZielOrdner & ZielDateiname
End If
'.. soll irgenwas mit dieser Datei passieren? die Datei ist dupliziert, aber noch nicht geöffnet
Next
End With
End Sub
Private Function Workbook_holen(ByVal Pfad As String) As Workbook
Dim Dateiname As String
'Dateiname extrahieren
Dateiname = Mid(Pfad, InStrRev(Pfad, "\") + 1)
'Prüfen ob bereit offen (fehlertolerant. Ergebnis wird geprüft)
On Error Resume Next
Set Workbook_holen = Workbooks(Dateiname)
'wenn nicht referenziert, dann öffnen
If Workbook_holen Is Nothing Then Set Workbook_holen = Workbooks.Open(Pfad)
End Function
Die Vorlage-Datei wird zuerst ausserhalb der For-Schleife geholt, und zwar mithilfe einer separate Funktion. Diese Funktion nutzt die Möglichkeit eine Fehler zu machen und diese auszuwerten, daher separat ("On Error" gilt immer nur innerhalb einer Prozedure).
Dateiname-bestandsteil werden in Variablen abgelegt.
In der Schleife wird stets die Vorlage unter einen neuen Namen gespeichert.
Voilà.
À bientôt
Yal