Add Comment Picture: Maintain Perspective Ratio

[Carl A]

From the Readme.txt

To install the Windows Image Acquisition Library v2.0,
copy the contents of this compressed file to a directory on your hard drive.

Copy the wiaaut.chm and wiaaut.chi files to your Help directory (usually located at C:\Windows\Help)

Copy the wiaaut.dll file to your System32 directory (usually located at C:\Windows\System32)

From a Command Prompt in the System32 directory run the following command:

RegSvr32 WIAAut.dll

As a added note if you have vb6 then you have extra controls available once you set a reference to the library in components .

Here is some sample code to resize your 800x600 jpg in the folder indicated.

[vba]Sub ResizePic()
Dim Img As ImageFile
Dim IP As ImageProcess
Dim sFName As String
Dim i As Integer

On Error GoTo AutoError
'Get Dir
sFName = Dir("C:\WINDOWS\Web\Wallpaper\")

Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
'Set i to one
i = 1
Do While Len(sFName) > 0
If Right(sFName, 3) = "jpg" Then 'Adjust to suit
'Load File
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\" & sFName & ""
'Resize
IP.Filters.Add IP.FilterInfos("Scale").FilterID
IP.Filters(i).Properties("MaximumWidth") = 150 'Will resize to 133
IP.Filters(i).Properties("MaximumHeight") = 100 'Will resize to 100
'Apply changes
Set Img = IP.Apply(Img)
'Save File
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\" & "Thumb" & sFName & ""
'increment IP.Filters
i = i + 1
End If
'Next File
sFName = Dir
Loop
Set Img = Nothing
Set IP = Nothing
Exit Sub
AutoError:
'Automation Error if Files are not found or saved file exist
If Err.Number = -2147024816 Then
MsgBox "File Already Exist", vbOKOnly
Resume Next
Else
MsgBox Err.Number & " " & Err.Description
End If

End Sub
[/vba] Also you can change the format of the image file see help for details.

Before I jump in w/ both feet, I am putting a couple toes in

Full body immersion is required.

Enjoy!

update wrong error code