Option Compare Database
Option Explicit
' Procedure : WIA_RotateImage
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Roate an image by a designated number of degrees using WIA
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Windows Image Acquisition (WIA)
' https://msdn.microsoft.com/en-us/library/windows/desktop/ms630368(v=vs.85).aspx
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sInitialImage : Fully qualified path and filename of the original image to resize
' sOutputImage : Fully qualified path and filename of where to save the new image
' lRotAng : Number of degree to roate the image
'
' Usage:
' ~~~~~~
' Call WIA_RotateImage("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg", _
' "C:\Users\MyUser\Desktop\Chrysanthemum_small.jpg", _
' 90)
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **********************************************************
' 1 2017-01-18 Initial Release
' 2 2018-09-20 Updated Copyright
'--------------------------------------------------------------------------
Public Function WIA_RotateImage(sInitialImage As String, _
sOutputImage As String, _
lRotAng As Long) As Boolean
On Error GoTo Error_Handler
Dim oWIA As Object 'WIA.ImageFile
Dim oIP As Object 'ImageProcess
'Should check if the output file already exists and if so,
'prompt the user to overwrite it or not
Set oWIA = CreateObject("WIA.ImageFile")
Set oIP = CreateObject("WIA.ImageProcess")
oIP.filters.Add oIP.FilterInfos("RotateFlip").FilterID
oIP.filters(1).Properties("RotationAngle") = lRotAng
oWIA.LoadFile sInitialImage
Set oWIA = oIP.Apply(oWIA)
oWIA.SaveFile sOutputImage
WIA_RotateImage = True
Error_Handler_Exit:
On Error Resume Next
If Not oIP Is Nothing Then Set oIP = Nothing
If Not oWIA Is Nothing Then Set oWIA = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: WIA_RotateImage" & vbCrLf & _
"Error Description: " & Err.description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function