um eine Übersicht in mehreren Excel Dateien die mit Links gefüllt ist immer aktuell zu halten habe ich mir mit einer Kollegin ein kleines VBA File zusammen geschrieben, das mit der Musterdatei abgeglichen werden soll. Momentan muss man aber die einzelnen Dateien auswählen die aktualisiert werden sollen. Dies soll nun automatisch passieren. Entweder durch hinzufügen der einzelnen Dateien im Code oder mit Angabe eines Ordners, was natürlich eleganter wäre. Nach langen rumprobieren ist es uns leider nicht gelungen. Könnte uns jemand bei dieser Problematik helfen? Anbei der Quellcode
Public Function GetFileNameFromPath(ByVal s As String) As String
s = Replace(s, ":", "/") ' aus allen Doppelpunkten wird ein Slash (Mac OS X Support)
GetFileNameFromPath = Mid$(s, InStrRev(s, "/") + 1)
End Function
Sub CopyRegisterUebersichtToAnotherFile()
Dim file As String
Dim path As String
Dim iam As String
path = GetFilenameFromDialog()
file = GetFileNameFromPath(path)
iam = ActiveWorkbook.Name
If Len(file) Then
Dim book As Excel.Workbook
Set book = Application.Workbooks.Open(path)
If book.Sheets("Übersicht").Name = "Übersicht" Then
Sheets("Übersicht").Name = "ÜbersichtBkp"
Windows(iam).Activate
Sheets("Übersicht").Copy Before:=book.Sheets("ÜbersichtBkp")
Sheets("ÜbersichtBkp").Delete
book.Close savechanges:=True
End If
End If
End Sub
Function GetFilenameFromDialog() As String
Dim sFilter As String, sCaption As String, sFile As String,
sFilter = "XLSM Dateien (*.xlsm),*.xlsm"
sCaption = "Please Select a File " & TheUser
sFile = Application.GetOpenFilename()
If sFile "False" Then
GetFilenameFromDialog = sFile
Else
GetFilenameFromDialog = ""
End If
End Function