Speichern und Fileformat beibehalten !
06.03.2019 13:20:29
Pramkies
Funktion:
Ich möchte Gerne mit einem Skript in einem Ordner alle Dateien Suchen und deren Atribute ändern zu können ...(Ersteldatum,Autor...). Bin jetzt soweit das ich erst nur Exeldateien finden kann! Ziel ist es Später (txt, Word,ppts,pdf zu ändern!)
Aber schritt für Schritt:
Mein Problem ist es, das ich die Datei öffne, Attribute ändere und beim speichern verliere ich immer den Fileformat.... bzw. es wird immer als exeldatei abgespeichert. Und nicht als Ursprungsformat.
Private Sub SearchInFolder(ByVal Folderspec As String) ' auslesen aufrufen mit Ordnername
Dim StTyp1 As String ' Dateityp
Dim StTyp2 As String ' Dateityp
Dim FSO As Object
Dim SearchFolder As Object
Dim FD As Object, FI As Object
Dim EachFil As Object, EachFold As Object
Dim LoI As Long ' Laufvariable zum schreiben der Ordner
Set FSO = CreateObject("Scripting.Filesystemobject")
StTyp1 = "xlsm"
StTyp2 = "xltx"
Set SearchFolder = FSO.GetFolder(Folderspec)
Set EachFil = SearchFolder.Files ' Dateien in der jeweiligen Root
' Dateien auslesen
For Each FI In EachFil ' Schleife über alle Dateien
' Dateityp feststellen
If UCase(Right(FI.Name, Len(FI.Name) - InStrRev(FI.Name, "."))) = UCase(StTyp1) Or _
UCase(Right(FI.Name, Len(FI.Name) - InStrRev(FI.Name, "."))) = UCase(StTyp2) Then
' MsgBox FI.Name
Name = FI.Name
' Name = Len(Name) - 4
Name = Left(Name, Len(Name) - 5)
Workbooks.Open SearchFolder & "\" & FI.Name
Call Eigenschaften_Arbeitsmappe ' Sub Atribute zu ändern
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=SearchFolder & "\" & Name ',FileFormat:= _
xlOpenXMLTemplate (hier will ich nicht angeben müssen welches Format..., soll dynamisch sein
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
End If
Next FI
Set EachFil = Nothing
Set EachFold = Nothing
Set FSO = Nothing
End Sub