Dieser Beitrag ist schon älter. Bitte vergewissern Sie sich, dass die Rahmenbedingungen oder der enthaltene Lösungsvorschlag noch dem aktuellen Stand der Technik entspricht.

Finden von Office-Dateien mit Schreibschutz

Mitglied: kerstine1981
Hallo!

Gibt es eine Möglichkeit, automatisiert bzw. mit sehr wenig Aufwand Office-Dateien zu suchen, die durch einen Schreibschutz geschützt sind???

Bin um jede Hilfe dankbar!

Danke,
kerstine

Content-Key: 4084

Url: https://administrator.de/contentid/4084

Ausgedruckt am: 23.06.2021 um 07:06 Uhr

4 Kommentare
Mitglied: gemini
Hallo,
vielleicht hilft dir das einwenig.
In der Variablen strExt stehen kommagetrennt die Dateiendungen.
Das Script durchsucht rekursiv alle Ordner unter dem in der InputBox angegebenen und gibt das Ergebnis mit Pfad in einer Datei aus.
~~~~~~~~~~~~~~~~~
Option Explicit

Dim objFSO, objFolder, objSubFld, objLog, f1, f2, colFiles, strExt, strMSG, arExt, strStart, i

strExt = "xls,doc,mdb,pps"
strMSG = "Schreibgeschützte Dateien"
strStart = InputBox("Wo solls denn losgehen?","Check4ReadOnly")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strStart)

ChkSubFld objFolder

Private Sub ChkSubFld(StartFolder)
ChkFiles StartFolder
Set objSubFld = StartFolder.SubFolders
For Each f2 in objSubFld
ChkSubFld f2
Next
End Sub

Private Sub ChkFiles(Start)
Set colFiles = Start.Files
For Each f1 in colFiles
arExt = Split(strExt, ",", -1, 1)
For i = 0 To UBound(arExt)
If LCase(Right(f1, 3)) = arExt(i) Then
If f1.Attributes AND 1 Then
strMSG = strMSG & vbCrLf & objFSO.GetAbsolutePathName(f1)
End If
End If
Next
Next
End Sub

Set objLog = objFSO.CreateTextFile("c:\CheckReadOnly.txt", True)
objLog.Write strMSG
objLog.Close

f1 = ""
f2 = ""
i = ""
strExt = ""
strMSG = ""
strStart = ""
colFiles = ""
~~~~~~~~~~~~~~~~~
Mitglied: kerstine1981
Hi!

Danke für den Tip - ich bekomm leider immer den fehler

Zeile 23, Zeichen 1
Zugriff verweigert...
Mitglied: gemini
Guten Morgen!

Ich hätte vielleicht noch dazuschreiben sollen, dass ich es nicht getestet habe.
Ist auch nicht sehr ausgefeilt, nur eben schnell hingeklopft.
War ja auch schon spät gestern.

In Ordnern die keine speziellen Unterordner (wie bspw. System Volume Information) haben sollte es schon laufen.

Ich seh es mir heute abend mal an.
Mitglied: gemini
Hallo Kerstin,

Zugriff verweigert = Du kommst hier net rein ;-) face-wink

Im Ernst, der Fehler tritt auf, wenn f2 in der Ordnerauflistung auf einen Ordner trifft für den die Rechte nicht ausreichen. Normalerweise haben User in solchen Ordnern nichts zu suchen und erst recht nichts zu speichern.

Um mir mein Wochenende zu retten ;-) face-wink hab ich mirs einfach gemacht.
Diese Fehler führen jetzt nicht mehr zum Abbruch (Resume Next).
~~~~~~~~~~~~~~~~~~~~
Option Explicit
On Error Resume Next

Dim objFSO, objFolder, objSubFld, objLog, f1, f2, colFiles, strExt, strMSG, arExt, strStart, strLog, i

strExt = "xls,doc,mdb,pps"
strStart = InputBox("Wo solls denn losgehen?","Check4ReadOnly")
strMSG = "Schreibgeschützte Dateien von " & strStart & " beginnend" & vbCrLf & "~~~~~~~~~~~~~~~~~~~~~~~~~~~"
strLog = "c:\CheckReadOnly.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strStart)

ChkSubFld objFolder

Private Sub ChkSubFld(StartFolder)
ChkFiles StartFolder
Set objSubFld = StartFolder.SubFolders
For Each f2 in objSubFld
ChkSubFld f2
Next
End Sub

Private Sub ChkFiles(Start)
Set colFiles = Start.Files
For Each f1 in colFiles
arExt = Split(LCase(strExt), ",", -1, 1)
For i = 0 To UBound(arExt)
If LCase(Right(f1, 3)) = arExt(i) Then
If f1.Attributes AND 1 Then
strMSG = strMSG & vbCrLf & objFSO.GetAbsolutePathName(f1)
End If
End If
Next
Next
End Sub

Set objLog = objFSO.CreateTextFile(strLog, True)
objLog.Write strMSG
objLog.Close

MsgBox "Fertig!"
LoadFile strLog

Private Sub LoadFile(File)
Dim objShell, strApplication
strApplication = "notepad.exe"
Set objShell = CreateObject("WScript.Shell")
objShell.Run strApplication & " " & File
set objShell = Nothing
End Sub

Set objFSO = Nothing
Set objFolder = Nothing
Set objLog = Nothing
f1 = ""
f2 = ""
i = ""
strExt = ""
strMSG = ""
strStart = ""
colFiles = ""
strLog = ""
strApp = ""
arExt = ""
~~~~~~~~~~~~~~~~~~~~
Schönes Wochenende
Heiß diskutierte Beiträge
general
Vorstellungsgespräch IT Administrator 2nd Level SupportGoldfuchsVor 1 TagAllgemeinWeiterbildung10 Kommentare

Moin ich habe demnächst ein Vorstellungsgespräch in einen Unternehmen für den Bereich des IT Administrators 2nd Level Support. Ich wollte da mal Euer Schwarmwissen abfragen ...

question
Glasfaseranschluss mit 4 Knotenpunkten auf 26 Häuser 1 Büro aufteilenchrisbaliVor 1 TagFrageEntwicklung18 Kommentare

hallo liebe Leute in der alten heimat Ganz vorweg ich Habe erstmal keine Ahnung und kenne den Spruch ...

question
Ein Anruf in Abwesenheit der gar nicht getätigt wurdeFabioIIVor 1 TagFrageOff Topic8 Kommentare

Servus zusammen. Mir ist heute folgendes passiert: Ich saß auf der Arbeit als mein Handy klingelte, da angeblich meine Freundin mich anruft. Nachdem ich den ...

question
Gastnetzwerk für Restaurant mit FritzBox 4040 gelöst Net-ZwerKVor 1 TagFrageLAN, WAN, Wireless11 Kommentare

Moin! Ich soll in einem kleinen Restaurant ein WLAN als Gastnetz einrichten. Aktuell ist vorhanden: Telekom Digitalisierungsbox Premium im Keller (macht ein WLAN, welches der ...

question
Minimaler Upload durch FritzBox im NetzwerkDoskiasVor 1 TagFrageLAN, WAN, Wireless22 Kommentare

Hallo zusammen, wir haben bei uns in der Firma ein separates Netz aufgebaut, welches einzig und alleine für Videokonferenzen genutzt wird. In der folgenden Darstellung ...

question
Server 2019: vcpus überbuchennixwissenderVor 1 TagFrageWindows Server15 Kommentare

hallo! wir betreiben einen etwas performanteren server mit 12 kernen, 128gb ram und einigen tb an speicherplatz in form vom nvme-platten, der uns als host ...

question
PDF aus Ordner automatisch versendenGundelputzVor 1 TagFrageMicrosoft11 Kommentare

Hallo zusammen, ich habe einen Ablauf den ich täglich mehrmals durchführen muss. - scannen in einen Ordner - gescannte PDF an ein Email Adresse in ...

question
Gast Wlan GatewayMaxHaxVor 1 TagFrageLAN, WAN, Wireless7 Kommentare

Servus!! Ich verwende zurzeit ein unifi Setup in einem Hotel mit alles unifi Geräte sogar das Gateway. Hab eine mgmt lan und gast vlan(captive Portal) ...