Attribute ändern FileSearch Excel 2010
07.10.2016 19:02:27
SteffenS
per Makros habe ich bisher immer die Dateiattribute geändert.
Leider funktioniert dies unter Excel 2010 nicht mehr. Es muss wohl an der FileSearch Funktion liegen.
Was kann ich tun, damit es wieder funktioniert. Die Dateien befinden sich in verschiednenen Verzeichnissen:
Sub attr_aendern()
Dim objFS As FileSearch
Dim strPath As String, strFile As String
Dim intIndex As Integer
Dim Dateiname As String
strPath = ThisWorkbook.Path & "\"
Set objFS = Application.FileSearch
With objFS
.NewSearch
.LookIn = strPath
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True ' Unterordner durchsuchen
If .Execute > 0 Then
For intIndex = 1 To .FoundFiles.Count
strFile = .FoundFiles(intIndex)
Dateiname = Dir(strFile)
Select Case Dateiname
Case ThisWorkbook.Name
Case Else
Dateiname = Dir(strFile)
If IstMappeOffen(Dateiname) = False Then Workbooks.Open Filename:=strFile, _
UpdateLinks:=0
' Setzen bzw. Aendern der Eigenschaft "Titel"
Workbooks(Dateiname).BuiltinDocumentProperties(1) _
= Workbooks(ThisWorkbook.Name).Sheets("Attr").Range("C3").Value
' Setzen bzw. Aendern der Eigenschaft "Thema"
Workbooks(Dateiname).BuiltinDocumentProperties(2) _
= Workbooks(ThisWorkbook.Name).Sheets("Attr").Range("C5").Value
' Setzen bzw. Aendern der Eigenschaft "Autor"
Workbooks(Dateiname).BuiltinDocumentProperties(3) _
'Dateiname = Dir
End Select
Next
End If
End With
Set objFS = Nothing
End Sub
VG Steffen
Anzeige