Ich habe in der Recherche den folgenden Code ausgegraben und würde ihn gerne dahingehen anpassen, eine Sicherheitskopie auf ein Netzlaufwerk zu schreiben
Gruß Alex
ption Explicit
Option Base 1
Option Private Module
Dim Feld(5, 2) As String
Public Sub sichern()
Dim index As Integer, Dateiname As String, Pfad As String
Dim FsyObjekt As Object, FiObjekt As Object
Set FsyObjekt = CreateObject("Scripting.FileSystemObject")
Pfad = "f:\test\"
With Application.FileSearch
.NewSearch
.LookIn = Pfad
.Filename = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 6) & "*"
.FileType = msoFileTypeExcelWorkbooks
If .Execute = 5 Then
For index = 1 To 5
Set FiObjekt = FsyObjekt.GetFile(.FoundFiles(index))
Feld(index, 1) = FiObjekt.DateCreated
Feld(index, 2) = index
Next
Call sortieren(1, 5)
Dateiname = .FoundFiles(Feld(1, 2))
Kill .FoundFiles(Feld(1, 2))
Else
Dateiname = Pfad & Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4) & CStr(.FoundFiles.Count + 1) & ".xls"
End If
End With
ThisWorkbook.SaveCopyAs Dateiname
End Sub
Private Sub sortieren(Untergrenze As Single, Obergrenze As Single)
Dim index1 As Single, index2 As Single, Element1 As Variant, Element2 As Variant
Dim Zwischenspeicher As Variant
index1 = Untergrenze
index2 = Obergrenze
Zwischenspeicher = Feld(((Untergrenze + Obergrenze) / 2) \ 1, 1)
Do
Do While Feld(index1, 1) < Zwischenspeicher
index1 = index1 + 1
Loop
Do While Zwischenspeicher < Feld(index2, 1)
index2 = index2 - 1
Loop
If index1 <= index2 Then
Element1 = Feld(index1, 1)
Element2 = Feld(index1, 2)
Feld(index1, 1) = Feld(index2, 1)
Feld(index1, 2) = Feld(index2, 2)
Feld(index2, 1) = Element1
Feld(index2, 2) = Element2
index1 = index1 + 1
index2 = index2 - 1
End If
Loop Until index1 > index2
If Untergrenze < index2 Then Call sortieren(Untergrenze, index2)
If index1 < Obergrenze Then Call sortieren(index1, Obergrenze)
End Sub