Creating a VBA WIA Image Manipulation Class Module

Over the years, I’ve published numerous articles about 1 off WIA functions:

and many others.

I decided that I explore taking all of these functions and transform them into a Class module.
 

Why a Class Module?

Great question!  Mostly for fun and learning.

Class modules offer us some great capabilities as you will see by the code presented below.

Originally, I set out wanting to see if I could replicate some of what I had achieved with my FreeImage demo.

Could we build something similar (not identical) using just a plain module and various functions, sure, but this article is intended as another class module learning tool.

Regarding Class Modules specifically, some might point out advantages like:

  • Object-Oriented Programming
  • Intellisense

 

The Class Module

Below is the class module I built from my various WIA functions and other dabblings.

In my case, I added a new Class Module to my project and renamed it ‘cls_WIA’ and inserted the following code.

Option Compare Database
Option Explicit

'--- cls_WIA ---
Private Const CLASS_NAME      As String = "cls_WIA"

Private mInputFile            As String
Private mOutputFile           As String
Private mImageFile            As Object    ' WIA.ImageFile
Private mImageProcess         As Object    ' WIA.ImageProcess
Private mLoaded               As Boolean

Public Enum wiaFormat
    wiaFormatBMP = 0
    wiaFormatGIF = 1
    wiaFormatJPEG = 2
    wiaFormatJPG = 2
    wiaFormatPNG = 3
    wiaFormatTIFF = 4
End Enum


'==============================
' Properties
'==============================

Public Property Get ClassName() As String
    ClassName = CLASS_NAME
End Property

Public Property Let InputFile(ByVal sFile As String)
    mInputFile = sFile
    LoadImageFile
    mLoaded = True
    Set mImageFile = Nothing
    Set mImageProcess = Nothing
End Property

Public Property Get InputFile() As String
    InputFile = mInputFile
End Property

Public Property Let OutputFile(ByVal sFile As String)
    mOutputFile = sFile
End Property

Public Property Get OutputFile() As String
    OutputFile = mOutputFile
End Property

' Read-only property for the WIA.ImageFile object
Public Property Get ImageFile() As Object
    If mImageFile Is Nothing Or Not mLoaded Then
        LoadImageFile
    End If
    Set ImageFile = mImageFile
End Property

' Read-only property for the WIA.ImageProcess object
Public Property Get ImageProcess() As Object
    If mImageProcess Is Nothing Then
        Set mImageProcess = CreateObject("WIA.ImageProcess")
    End If
    Set ImageProcess = mImageProcess
End Property

' Read-only property for the Filters count
Public Property Get FiltersCount() As Long
    FiltersCount = Me.ImageProcess.Filters.Count
End Property

Public Sub Clear() 'not a prop, I know
    Set mImageFile = Nothing
End Sub


'==============================
' Public Methods
'==============================

Private Sub LoadImageFile()
    If mInputFile = "" Then _
       Err.Raise vbObjectError + 1000, CLASS_NAME, _
       "No Input File Defined.  Use .InputFile to define the image file."
    Set mImageFile = CreateObject("WIA.ImageFile")
    mImageFile.LoadFile mInputFile
    mLoaded = True
    'Set mImageProcess = Nothing
End Sub

' Applies all filters in mImageProcess to mImageFile and resets mImageProcess
Public Sub ApplyFilters()
    If mImageFile Is Nothing Then LoadImageFile
    If Not mImageProcess Is Nothing And mImageProcess.Filters.Count > 0 Then
        Set mImageFile = mImageProcess.Apply(mImageFile)
        Set mImageProcess = Nothing
    End If
End Sub

' Reload image from file (if needed)
Public Sub ReloadImage()
    LoadImageFile
End Sub

' Save the current image (after processing)
Public Sub Save(Optional ByVal sOutputPath As String = "")
    Dim sTargetPath           As String

    If mImageFile Is Nothing Then _
       Err.Raise vbObjectError + 515, CLASS_NAME, _
       "No image loaded or filters applied. Call ApplyFilters before Save."

    ' Priority: outputPath argument > OutputFile property > InputFile property
    If sOutputPath <> "" Then
        sTargetPath = sOutputPath
    ElseIf mOutputFile <> "" Then
        sTargetPath = mOutputFile
    ElseIf mInputFile <> "" Then
        sTargetPath = mInputFile
    Else
        Err.Raise vbObjectError + 514, CLASS_NAME, "No output path or input file specified."
    End If

    ' Overwrite the original file first if it exists
    '   ***** Maybe add a user prompt to confirm *****
    If Dir(sTargetPath) <> "" Then Kill sTargetPath

    '    ' Next 3 lines are optional depending on the approach you wish to use.
    '    If Not mImageProcess Is Nothing And mImageProcess.Filters.Count > 0 Then
    '        ApplyFilters
    '    End If

    mImageFile.SaveFile sTargetPath
End Sub

' Rotate by 90, 180, or 270 degrees
Public Sub Rotate(iAngle As Integer)
    Dim oIP                   As Object

    If iAngle = 0 Then Exit Sub     'Nothing to do with a 0 angle!

    If iAngle = -180 Then iAngle = 180
    If iAngle = -90 Then iAngle = 270

    ' Only accept 90, 180, 270 as angles
    If iAngle <> 90 _
       And iAngle <> 180 _
       And iAngle <> 270 Then
        Err.Raise vbObjectError + 513, CLASS_NAME, "Rotation angle must be 90, 180, or 270."
    End If

    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("RotateFlip").FilterID
    oIP.Filters(oIP.Filters.Count).Properties("RotationAngle") = iAngle
End Sub

' Flip horizontally and/or vertically
Public Sub Flip(Optional bFlipHorizontally As Boolean = False, _
                Optional bFlipVertically As Boolean = False)
    Dim oIP                   As Object
    
    If Not bFlipHorizontally And Not bFlipVertically Then Exit Sub
    
    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("RotateFlip").FilterID
    If bFlipHorizontally Then oIP.Filters(oIP.Filters.Count).Properties("FlipHorizontal") = True
    If bFlipVertically Then oIP.Filters(oIP.Filters.Count).Properties("FlipVertical") = True
End Sub

' Queues a Scale filter (resize) to the ImageProcess
Public Sub Resize(lMaximumWidth As Long, _
                  lMaximumHeight As Long, _
                  Optional bPreserveAspectRatio As Boolean = True)
    Dim oIP                   As Object
    
    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("Scale").FilterID
    With oIP.Filters(oIP.Filters.Count)
        .Properties("MaximumWidth") = lMaximumWidth
        .Properties("MaximumHeight") = lMaximumHeight
        .Properties("PreserveAspectRatio") = bPreserveAspectRatio
    End With
End Sub

' Define the format/quality of the output file
Public Sub ConvertImage(lTargetFormat As wiaFormat, _
                        Optional lQuality As Long = 85)
    Dim sFormatID             As String
    Dim oIP                   As Object

    Select Case lTargetFormat
        Case wiaFormatBMP
            sFormatID = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
        Case wiaFormatGIF
            sFormatID = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
        Case wiaFormatJPEG
            sFormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
        Case wiaFormatPNG
            sFormatID = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
        Case wiaFormatTIFF
            sFormatID = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
        Case Else
            Err.Raise vbObjectError + 520, CLASS_NAME, "Unsupported format."
    End Select

    If lQuality > 100 Then lQuality = 100
    If lQuality < 0 Then lQuality = 0 'Kind of useless, perhaps we should set a minimum???

    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("Convert").FilterID
    With oIP.Filters(oIP.Filters.Count)
        .Properties("FormatID") = sFormatID
        If lTargetFormat = wiaFormatJPEG Then
            .Properties("Quality") = lQuality
        End If
    End With
End Sub

' List all EXIF properties
Public Function GetExifPropertyValues() As String
    Dim oIF                   As Object    ' WIA.ImageFile
    Dim prop                  As Object   ' WIA.Property
    Dim props()               As Variant
    Dim i As Long, j          As Long
    Dim temp                  As Variant
    Dim sOutput               As String

    Set oIF = Me.ImageFile

    ' Creat to an array of the properties where the 1st element is the property name, for sorting
    ReDim props(1 To oIF.Properties.Count, 1 To 2)
    i = 1
    For Each prop In oIF.Properties
        props(i, 1) = prop.Name
        Set props(i, 2) = prop
        i = i + 1
    Next

    ' ort the array by prop.Name
    For i = 1 To UBound(props) - 1
        For j = i + 1 To UBound(props)
            If StrComp(props(i, 1), props(j, 1), vbTextCompare) > 0 Then
                temp = props(i, 1)
                props(i, 1) = props(j, 1)
                props(j, 1) = temp

                Set temp = props(i, 2)
                Set props(i, 2) = props(j, 2)
                Set props(j, 2) = temp
            End If
        Next j
    Next i

    ' Build the output from sorted array
    sOutput = "Name~Decimal~HEX~Type~Type~Value" & vbCrLf
    For i = 1 To UBound(props)
        Set prop = props(i, 2)
        sOutput = sOutput & prop.Name & _
                  "~" & prop.PropertyID & _
                  "~" & DecimalToHex(prop.PropertyID) & _
                  "~" & GetVarTypeName(VarType(prop.Value)) & _
                  "~" & GetWiaImagePropertyType(prop.Type) & _
                  "~" & GetPropertyValueAsString(prop) & vbCrLf
    Next

    GetExifPropertyValues = sOutput
End Function

' Sets an EXIF property (ID, Type, Value) using the EXIF filter
Public Sub SetExifProperty(lPropertyId As Long, _
                           lPropertyType As Long, _
                           vPropertyValue As Variant)
    Dim oIP                   As Object

    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("Exif").FilterID
    With oIP.Filters(oIP.Filters.Count)
        .Properties("ID") = lPropertyId
        .Properties("Type") = lPropertyType
        .Properties("Value") = vPropertyValue
    End With
End Sub

Sub RemoveExifProperty(lPropertyId As Long)
    Dim oIF                   As Object
    Dim oIP                   As Object
    Dim oProp                 As Object

    If lPropertyId <> 269 Then    'We have to leave the DocumentName property!
        Set oIF = Me.ImageFile
        Set oIP = Me.ImageProcess

        With oIP
            .Filters.Add (.FilterInfos("Exif").FilterID)
            .Filters(oIP.Filters.Count).Properties("ID") = lPropertyId
            .Filters(oIP.Filters.Count).Properties("Remove") = True
        End With
    End If
End Sub

Sub RemoveAllExifProperties()
    Dim oIF                   As Object
    Dim oIP                   As Object
    Dim oProp                 As Object

    Set oIF = Me.ImageFile
    Set oIP = Me.ImageProcess

    For Each oProp In oIF.Properties
        If oProp.PropertyID <> 269 Then    'We have to leave the DocumentName property!
            With oIP
                .Filters.Add (.FilterInfos("Exif").FilterID)
                .Filters(oIP.Filters.Count).Properties("ID") = oProp.PropertyID
                .Filters(oIP.Filters.Count).Properties("Remove") = True
            End With
        End If
    Next oProp
End Sub

' Returns the binary data of the loaded image as a byte array
'   this can be used with an Access' Image control  Me.ImgCtrl.PictureData = .GetBinaryData
Public Function GetBinaryData() As Variant
    If mImageFile Is Nothing Then _
       Err.Raise vbObjectError + 516, CLASS_NAME, _
       "No image loaded. Load an image before calling GetBinaryData."
    GetBinaryData = mImageFile.fileData.BinaryData
End Function

' Get StdPicture for use in forms or clipboard
Public Function GetStdPicture() As StdPicture
    Set GetStdPicture = mImageFile.fileData.Picture
End Function

' Orient image based on Orientation property value
Public Sub AutoOrient()
    Dim oIF                   As Object
    Dim vOrientation          As Variant
    Dim bPropertyExists       As Boolean

    Set oIF = Me.ImageFile

    'ReOrient the image based on the Orientation Exif Property value
    If oIF.Properties.Exists("274") Then
        vOrientation = oIF.Properties("274").Value
        bPropertyExists = True

        Select Case vOrientation
                ' Case 1: Normal, do nothing
            Case 2: Me.Flip bFlipHorizontally:=True
            Case 3: Me.Rotate 180
            Case 4: Me.Flip bFlipVertically:=True
            Case 5: Me.Rotate 90: Me.Flip bFlipHorizontally:=True
            Case 6: Me.Rotate 90
            Case 7: Me.Rotate 270: Me.Flip bFlipHorizontally:=True
            Case 8: Me.Rotate 270
        End Select
    End If

    ' Reset the Orientation property to "1" (normal) if it existed
    If bPropertyExists Then _
       Me.SetExifProperty 274, 1003, 1
End Sub

Function WIA_GetAllExifProperties(sImage As String)
'https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-shared-samples#display-all-imagefile-properties
    On Error GoTo Error_Handler
    '#Const WIA_EarlyBind = False    'True => Early Binding / False => Late Binding
    #If WIA_EarlyBind = True Then
        'Early Binding req: Microsoft Windows Image Acquisition Library vX.X
        Dim oIF               As WIA.ImageFile
        Dim oV                As WIA.Vector
        Dim oPrp              As WIA.Property

        Set oIF = New WIA.ImageFile
        Set oV = New WIA.Vector
    #Else
        Dim oIF               As Object
        Dim oV                As Object
        Dim oPrp              As Variant
        Const RationalImagePropertyType = 1006    '(&H3EE)

        Set oIF = CreateObject("WIA.ImageFile")
        Set oV = CreateObject("WIA.Vector")
    #End If
    Dim sValue                As String
    Dim lCounter              As Long
    Dim lCounter2             As Long

    oIF.LoadFile sImage

    Debug.Print "No.", "ID", "Name", "Type", "Value"
    On Error Resume Next
    For Each oPrp In oIF.Properties
        lCounter = lCounter + 1    'Element counter
        With oPrp
            If .PropertyID <> 20507 And .PropertyID <> 20624 And .PropertyID <> 20625 Then
                If .IsVector = False Then
                    If .Type = RationalImagePropertyType Then
                        Debug.Print lCounter, .PropertyID, .Name, GetWiaImagePropertyType(.Type), .Value.Numerator & "/" & .Value.Denominator
                    Else
                        Debug.Print lCounter, .PropertyID, .Name, GetWiaImagePropertyType(.Type), .Value
                    End If
                Else
                    'Vector objects
                    Set oV = .Value
                    For lCounter2 = 1 To oV.Count
                        sValue = sValue & oV.Item(lCounter2) & " "
                    Next lCounter2
                    sValue = Trim(sValue)
                    Debug.Print lCounter, .PropertyID, .Name, GetWiaImagePropertyType(.Type), sValue
                End If
            End If
        End With
    Next oPrp

Error_Handler_Exit:
    On Error Resume Next
    If Not oV Is Nothing Then Set oV = Nothing
    If Not oIF Is Nothing Then Set oIF = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: WIA_GetExifProperty" & 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

Function GetPropertyValueAsString(oProp As Variant) As String
    Dim sOutput               As String
    Dim sOutput2              As String
    Dim oV                    As Object    'As WIA.Vector
    Dim lCounter              As Long
    Const RationalImagePropertyType = 1006

    With oProp
        ' 20507 => Thumbnail Data
        ' 20624 => Luminance Table
        ' 20625 =>
        If .PropertyID <> 20507 And .PropertyID <> 20624 And .PropertyID <> 20625 Then
            If .IsVector = False Then
                If .Type = RationalImagePropertyType Then
                    sOutput = .Value.Numerator & "/" & .Value.Denominator
                Else
                    sOutput = .Value
                End If
            Else
                'Vector objects
                Set oV = .Value
                For lCounter = 1 To oV.Count
                    sOutput = sOutput & Chr(oV.Item(lCounter))
                    sOutput2 = sOutput2 & oV.Item(lCounter) & " "
                Next lCounter
                sOutput = Trim(sOutput) & " | " & Trim(sOutput2)
                'Debug.Print lCounter, .PropertyID, .Name, GetWiaImagePropertyType(.Type), sValue
            End If
        Else
            sOutput = "[--- Omitted ---]"
        End If
    End With

    GetPropertyValueAsString = sOutput
End Function


'==============================
' Private Helpers
'==============================

Function GetVarTypeName(vt As Integer) As String
    Select Case vt
        Case vbEmpty: GetVarTypeName = "Empty"
        Case vbNull: GetVarTypeName = "Null"
        Case vbInteger: GetVarTypeName = "Integer"
        Case vbLong: GetVarTypeName = "Long"
        Case vbSingle: GetVarTypeName = "Single"
        Case vbDouble: GetVarTypeName = "Double"
        Case vbCurrency: GetVarTypeName = "Currency"
        Case vbDate: GetVarTypeName = "Date"
        Case vbString: GetVarTypeName = "String"
        Case vbObject: GetVarTypeName = "Object"
        Case vbError: GetVarTypeName = "Error"
        Case vbBoolean: GetVarTypeName = "Boolean"
        Case vbVariant: GetVarTypeName = "Variant"
        Case vbDataObject: GetVarTypeName = "DataObject"
        Case vbByte: GetVarTypeName = "Byte"
        Case vbArray + vbByte: GetVarTypeName = "Byte Array"
        Case vbArray + vbVariant: GetVarTypeName = "Variant Array"
        Case Else: GetVarTypeName = "Unknown/Other"
    End Select
End Function

Public Function GetWiaFormatValue(ByVal sFormatName As String) As Variant
    Select Case LCase(sFormatName)
        Case "wiaformatbmp"
            GetWiaFormatValue = wiaFormat.wiaFormatBMP
        Case "wiaformatgif"
            GetWiaFormatValue = wiaFormat.wiaFormatGIF
        Case "wiaformatjpeg", "wiaformatjpg"
            GetWiaFormatValue = wiaFormat.wiaFormatJPEG
        Case "wiaformatpng"
            GetWiaFormatValue = wiaFormat.wiaFormatPNG
        Case "wiaformattiff"
            GetWiaFormatValue = wiaFormat.wiaFormatTIFF
        Case Else
            GetWiaFormatValue = -1
    End Select
End Function

Private Function GetWiaImagePropertyType(ByVal lType As Long) As String
    Select Case lType
        Case 1000
            GetWiaImagePropertyType = "Undefined"
        Case 1001
            GetWiaImagePropertyType = "Byte"
        Case 1002
            GetWiaImagePropertyType = "String"
        Case 1003
            GetWiaImagePropertyType = "Unsigned Integer"
        Case 1004
            GetWiaImagePropertyType = "Long"
        Case 1005
            GetWiaImagePropertyType = "Unsigned Long"
        Case 1006
            GetWiaImagePropertyType = "Rational"
        Case 1007
            GetWiaImagePropertyType = "Unsigned Rational"
        Case 1100
            GetWiaImagePropertyType = "Vector Of Undefined"
        Case 1101
            GetWiaImagePropertyType = "Vector Of Bytes"
        Case 1102
            GetWiaImagePropertyType = "Vector Of Unsigned"
        Case 1103
            GetWiaImagePropertyType = "Vector Of Longs"
        Case 1104
            GetWiaImagePropertyType = "Vector Of UnsignedLongs"
        Case 1105
            GetWiaImagePropertyType = "Vector Of Rationals"
        Case 1106
            GetWiaImagePropertyType = "Vector Of Unsigned Rationals"
        Case Else
            GetWiaImagePropertyType = "Unknown Type"
    End Select
End Function

' Convert Decimal to Hexadecimal (optionally with the 0x prefix)
Public Function DecimalToHex(lDecValue As Long, _
                             Optional bIncludePrefix As Boolean = True) As String
    DecimalToHex = Hex(lDecValue)
    If bIncludePrefix Then DecimalToHex = "0x" & DecimalToHex
End Function

' Convert Hexadecimal (with 0x prefix) to Decimal
Public Function HexToDecimal(sHexValue As String) As Long
    Dim sCleanHex             As String

    sCleanHex = Replace(sHexValue, "0x", "")
    HexToDecimal = CLng("&H" & sCleanHex)
End Function

Function FormatFileSize(ByVal dNoBytes As Double) As String
    If dNoBytes < 1024 Then
        FormatFileSize = dNoBytes & " B"
    ElseIf dNoBytes < 1048576 Then    ' 1024^2
        FormatFileSize = Format(dNoBytes / 1024, "0.00") & " KB"
    ElseIf dNoBytes < 1073741824 Then    ' 1024^3
        FormatFileSize = Format(dNoBytes / 1048576, "0.00") & " MB"
    Else
        FormatFileSize = Format(dNoBytes / 1073741824, "0.00") & " GB"
    End If
End Function

 

Usage Example(s)

I know that at first class modules can seem intimidating, but as you will see by the example(s) below, they simplify coding.

Getting Some Image Information

    Dim cWIA                  As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"

        ' Access the WIA objects and filters count
        With .ImageFile
            Debug.Print .Width
            Debug.Print .Height
            Debug.Print .HorizontalResolution
            Debug.Print .VerticalResolution
            Debug.Print .IsAnimated
            Debug.Print .ActiveFrame
            Debug.Print .FrameCount
            Debug.Print .FileExtension
            Debug.Print .IsAlphaPixelFormat
            Debug.Print .PixelDepth
            Debug.Print .FormatID
            Debug.Print .IsExtendedPixelFormat
            Debug.Print .IsIndexedPixelFormat
        End With

        .Clear
    End With

    Set cWIA = Nothing

Rotate an Image

    Dim cWIA              As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"
        .OutputFile = "C:\Temp\Landscape_3_rotated.jpg"

        .Rotate 180
        .ApplyFilters

        .Save
        .Clear
    End With
    
    Set cWIA = Nothing

Convert an Image from JPG to BMP

    Dim cWIA                  As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"
        .OutputFile = "C:\Temp\Landscape_3.bmp"

        .ConvertImage wiaFormatBMP
        .ApplyFilters

        .Save
        .Clear
    End With

    Set cWIA = Nothing

AutoOrient, Resize and Convert an Image

    Dim cWIA                  As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"
        .OutputFile = "C:\Users\Dev\Desktop\MyPic.png"

        .AutoOrient
        .Resize 300, 300, True
        .ConvertImage wiaFormatPNG
        .ApplyFilters

        .Save
        .Clear
    End With

    Set cWIA = Nothing

 

Displaying Your Changes

One of the really nice things with WIA is you can in fact apply changes to your base image and display the resulting image without ever needing to first saving the file to disk.

If you have an Image control, you could do something like:

Me.ImageControlName.PictureData = .GetBinaryData

So as a full example, retaking the previous example, we could do:

    Dim cWIA                  As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"
        .OutputFile = "C:\Users\Dev\Desktop\MyPic.png"

        .AutoOrient
        .Resize 300, 300, True
        .ConvertImage wiaFormatPNG
        .ApplyFilters

        Me.ImageControlName.PictureData = .GetBinaryData
    End With

    Set cWIA = Nothing

Then I'd provide a seperate button to save the results, but only when the user is ready to save things permanently.
 

Order Matters

One important thing to note when performing operations on images is that the order of operations can impact the final output.

One such example would be that you should do your resizing or cropping after having performed any necessary rotation, otherwise you won't get the desired final result.
 

Conclusion

So there you have it, image manipulation at its finest!

One of the great things of using WIA is that you can actually perform manipulations all in memory, even displaying/previewing the results in an image control, without needing to continuously save the changes to the hard drive, eliminating useless I/O operations. Thus, you only perform the .Save operation once you are happy with the results.

WIA is built into Windows so nothing to install, it is bitness independent, so no worries about 32 vs 64-bit installations and works in all VBA applications (Access, Excel, Word, Outlook, ...).

 

Page History

Date Summary of Changes
2025-06-02 Initial Release

4 responses on “Creating a VBA WIA Image Manipulation Class Module

  1. John F Clark

    Good stuff Daniel. I do not have a need for this at the moment, but its good to know that should the need arise, there is a tool in the toolbox.
    Class Modules have always been a mystery to me, I like the way you laid it out and commented on it.

    1. Daniel Pineault Post author

      I too have always preferred the use of standard Modules and the simplicity they bring to code. Code should be simple, easy to follow, trace, …

      I have often found that developers coming from other languages seem to privilege Class Modules greatly, and in many cases needlessly over complexify their code for no reason.

      Class Modules offer certain advantages and can be useful in the right contexts, but in many instance a standard Module will do just fine and doesn’t require the hoopla that Class modules require.

      Even this class module could be re-written as a standard module in which we would pass the ImageFile, ImageProcess to the functions.

      So, that’s a long winded way of saying there are a multitude of ways of doing the same thing and a lot of it comes down to personal preferences.

      This article was truly for me as an exploration of what could be done with my more basic individual WIA functions, and I figured I’d share it should it be useful to others.

  2. Montaser

    First, I would like to thank you for this wonderful code that saves a lot of time and effort.
    However, when I applied the examples, I noticed that the first command must be AutoOrient; otherwise, I get the following message:

    “Runtime error ‘91’:
    Object variable or With block variable not defined.”

    In other words, when I execute the code to rotate the image as described in the article, the error message appears. However, if I add the AutoOrient command before the Rotate 180 command, it works successfully.
    The same applies to the conversion code.

    1. Daniel Pineault Post author

      I haven’t had time to properly test, but in ‘Private Sub LoadImageFile()’ try commenting out the last line ‘Set mImageProcess = Nothing’.