Zugriff auf bestimmte Files und Folders

Ausgangslage:
Es gibt eine Masterdatei, welche sich Werte aus zahlreiche Quelldateien (an jeweils unterschiedlicher Stelle) holt. Grundsätzlich funktioniert das Aktualisieren der Daten. Es sei denn, ein User hat eine der Quelldateien umbenennt oder verschoben. Oder der User, welche die Masterdatei öffnet, hat keine Leseberechtigung für eine oder alle Quelldateien.
Ziel:
Ich möchte folgendes Verhalten beim Öffnen der Masterdatei:
- Es soll eine Meldung erfolgen bei fehlender Berechtigung auf die Quelldatei(en)
- Es soll eine Meldung erfolgen, wenn Quelldatei(en) nicht existieren
- Die Werte sollen gleich beim Öffnen aktualisiert werden
- Die Masterdatei soll offen bleiben im Anschluss an eine Meldung
Mit meinen bescheidenen VBA-Kenntnissen stehe ich nun an folgenden Punkten an:
- Wie bekomme ich die unterschiedlichen Dateipfade in ein Array? (in Realität sind es deutlich mehr als drei Dateien)
- Motivation für das Array: ich möchte mit einer Schleife die Berechtigung, die Datei-Existenz und das letzte Speicherdatum prüfen/abfragen.
- Mein rudimentärer Ansatz funktioniert nur bedingt: bei Bestätigung einer Error-Meldung schliesst sich Excel, was in diesem Fall unerwünscht ist.
- Ziel ist, dass die Fehlermeldung differenziert ausfällt.
Danke für eure Hilfe.
Mein bisheriger Code:
Option Explicit


Private Sub Workbook_Open()
'Variablen
Dim dirBCH As String
Dim dirKKJ As String
Dim dirTMP As String
'Stellenplan-Excel-Quelldateien
dirBCH = "\\PfadA\bch.xlsx"
dirKKJ = "\\PfadB\kkj.xlsx"
dirTMP = "\\PfadC\tmp.xlsx"
On Error GoTo Fehler
'Alle Stellenplan-Excel-Quellendateien aktualisieren
Call ThisWorkbook.UpdateLink(Name:=ThisWorkbook.LinkSources, Type:=xlLinkTypeExcelLinks)
'Aktualisieren Speicherdatum Stellenplan-Excel-Quelldateien
'BCH
Range("U6").Value = FileDateTime(dirBCH)
Range("U15").Value = FileDateTime(dirBCH)
Range("U16").Value = FileDateTime(dirBCH)
Range("U27").Value = FileDateTime(dirBCH)
'KKJ
Range("U8").Value = FileDateTime(dirKKJ)
Range("U18").Value = FileDateTime(dirKKJ)
Range("U29").Value = FileDateTime(dirTMP)
MsgBox "Alle Daten wurden aktualisiert!"
Exit Sub
Fehler
MsgBox "Keine Aktualisierung der verknüpften Werte! Berechtigung auf  X, Y fehlt bzw. Folder A, B existiert nicht."
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() lstrFile As String, lstrArr() As String ReDim lstrArr(0) lstrFile = Dir("\\PfadA\*.xlsx") Do Until lstrFile = "" lstrArr(UBound(lstrArr) = "\\PfadA\ & lstrFile ReDim Preserve lstrArr(UBound(lstrArr) + 1) Loop ReDim Preserve lstrArr(UBound(lstrArr) - 1) End Sub

Hi,
zu 1. hast du mich falsch verstanden - oder ich dich noch immer nicht :-)
Natürlich weiß Excel, mit welchen Dateien seine Datei verknüpft ist, sonst könnte Excel ja nicht updaten ;-)
Aber ich hatte gedacht, du willst dann rausfinden, wie der "neue" Name der Datei ist, wenn Datei umbenannt wurde, damit der "neue" Name in Excels Verknüpfungen angepasst werden kann, damit eben das Update wieder möglich ist.
Und genau hier sah ich das Problem, dass genau das nicht geht, weil Excel ja den neuen Namen der Datei nicht kennen kann.
Ok, da war ich wohl einen Schritt zu weit - du willst den "neuen" Dateinamen gar nicht anpassen, sondern nur wissen, welcher Name geändert wurde und genau dafür ne Fehler-MsgBox ausgeben.
Ciao
Thorsten

Function HatLeseBerechtigung(strFile As String) As Boolean On Error GoTo ERREXIT Open strFile For Input As #1 ERREXIT: Close #1 If Err.Number = 75 Then HatLeseBerechtigung = False Else HatLeseBerechtigung = True End If End Function

Private Sub Workbook_Open() Datei_lesen End Sub Sub Datei_lesen() 'unter Anbindung von "Microsoft Scripting Runtime" ("Extras", "Verweise...", Haken bei der benannten Library) Dim arrDatei Dim FSO As New FileSystemObject Dim DateiPfad Dim Datei As File Dim DateiZahl As Long arrDatei = Array("\\PfadA\bch.xlsx", "\\PfadB\kkj.xlsx", "\\PfadC\tmp.xlsx") On Error GoTo Catch Try: For Each DateiPfad In arrDatei Set Datei = Nothing Set Datei = FSO.GetFile(DateiPfad) If Not Datei Is Nothing Then DateiZahl = DateiZahl + 1 With Worksheets(1).Range("A9999").End(xlUp) .Offset(1, 0) = Datei.ShortPath .Offset(1, 1) = Datei.Name .Offset(1, 2) = Datei.DateLastModified End With End With Next MsgBox "Es wurden " & DateiZahl & " Dateien gelesen." GoTo Finally Catch: Select Case Err.Number Case 666 'ersetzen durch Fehlernummer für Datei nicht gefunden MsgBox "Datei """ & DateiPfad & """ nicht gefunden." Resume Next Case 777 'ersetzen durch Fehlernummer für fehlende Leserechte MsgBox "Fehlende Leserechte für Datei """ & DateiPfad & """." Resume Next Case Else MsgBox "Sonstige Fehler. Abbruch" End Select Finally: 'in dem Fall nichts End Sub

Beliebteste Forumthreads (12 Monate)

Zugriff auf bestimmte Files und Folders

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread