AW: Bilder komprimieren
14.09.2022 10:24:24
Nepumuk
Hallo Andy,
dann so:
Option Explicit
Public Sub Test()
Const INPUT_FOLDER As String = "D:\Original\" ' Anpassen, Backslash am ende nicht loeschen !!!
Const OUTPUT_FOLDER As String = "D:\Kompromiert\" ' Anpassen, Backslash am ende nicht loeschen !!!
Dim objImageFile As Object, objImageProcess As Object
Dim objFileSystemObject As Object
Dim strFilename As String, strOutputPath As String
Set objImageFile = CreateObject(Class:="WIA.ImageFile")
Set objImageProcess = CreateObject(Class:="WIA.ImageProcess")
Set objFileSystemObject = CreateObject(Class:="Scripting.FileSystemObject")
With objImageProcess
Call .Filters.Add(FilterID:=.FilterInfos("Convert").FilterID)
.Filters.Item(1).Properties("FormatID") = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
.Filters.Item(1).Properties("Quality") = 10 ' Anpassen !!!
End With
strFilename = Dir$(INPUT_FOLDER & "*.jpg")
Do Until strFilename = vbNullString
Call objImageFile.LoadFile(Filename:=INPUT_FOLDER & strFilename)
Set objImageFile = objImageProcess.Apply(Source:=objImageFile)
strOutputPath = OUTPUT_FOLDER & "Komprimiert_" & strFilename
If objFileSystemObject.FileExists(strOutputPath) Then Call Kill(strOutputPath)
Call objImageFile.SaveFile(Filename:=strOutputPath)
strFilename = Dir$
Loop
Set objFileSystemObject = Nothing
Set objImageProcess = Nothing
Set objImageFile = Nothing
End Sub
Gruß
Nepumuk