extract image from Ms Excel using Ms Access Vba

New Contributor

Using MS Access and Vba, I need to extract images contained in an excel file, sheet n. 2 and save them in a directory on the pc.
Where can I find information?
Thanks in advance

Marco Dell'Oca

5 Replies


I use this in Excel (VBA). This subroutine exports pictures by first converting them to a chart object that can be saved to a folder. You can either use this in Excel or port it to Access VBA:

Sub SaveAllPictures()
    Dim shPictures
    Set shPictures = ActiveWorkbook.Sheets(2)
    Dim oShape As Shape
    Dim strPictureName As String
    Dim oChartObject As ChartObject
    Dim oChart As Chart
    For Each oShape In ActiveSheet.Shapes
        strPictureName = oShape.Name
        Selection.ShapeRange.PictureFormat.Contrast = 0.5
        Selection.ShapeRange.PictureFormat.Brightness = 0.5
        Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
        Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.Line.Visible = msoFalse
        Selection.ShapeRange.Rotation = 0#
        Selection.ShapeRange.PictureFormat.CropLeft = 0#
        Selection.ShapeRange.PictureFormat.CropRight = 0#
        Selection.ShapeRange.PictureFormat.CropTop = 0#
        Selection.ShapeRange.PictureFormat.CropBottom = 0#
        Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft

        Set oChartObject = ActiveSheet.ChartObjects.Add(0, 0, oShape.Width, oShape.Height)
        Set oChart = oChartObject.Chart
        With oChart
            .Export ("..." & strPictureName & ".jpg") '<-- add your folder here
        End With
    Set shPictures = Nothing
End Sub


Best regards,


best response confirmed by Marco_DellOca (New Contributor)

@Tieme Woldman

thanks Tieme,

I solved the problem by reading the Excel file from Access in this way:



    Dim XL As Excel.Application
    Dim WB As Excel.Workbook
    Dim WS As Excel.Worksheet
    Dim SH As Excel.Worksheet
    Set XL = CreateObject("Excel.Application")
    Set WB = XL.Workbooks.Open(<file Excel path>)
    XL.Visible = False
    WB.Worksheets(sheet_no + 1).Select
    Set WS = WB.ActiveSheet
    Set SH = WB.Worksheets.Item(sheet_no + 1)

    Dim output_folder As String
    Dim image As Object, image_name As String, img_dimension As Variant, img_area As Variant
    output_folder = CurrentProject.Path & "\Temp\"

    For Each image In ActiveSheet.Shapes
        image_name = image.TopLeftCell.Row & "_" & image.TopLeftCell.Column
        With Selection.ShapeRange
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            .Rotation = 0#
            .ScaleHeight 1#, msoTrue, msoScaleFromTopLeft
            .ScaleWidth 1#, msoTrue, msoScaleFromTopLeft
        End With
        With Selection.ShapeRange.pictureFormat
            .CropLeft = 0#
            .CropRight = 0#
            .CropBottom = 0#
            .CropTop = 0#
            .TransparentBackground = msoFalse
        End With
        Set img_dimension = ActiveSheet.ChartObjects.Add(0, 0, image.Width, image.Height)
        Set img_area = img_dimension.Chart
        With img_area
            .Export (output_folder & "\" & image_name & ".jpg")
        End With
    Set XL = Nothing
    Set WB = Nothing
    Set WS = Nothing
    Set SH = Nothing
Exit Sub
    MsgBox "the immage: " & image_name & " was not exported."
Resume successivo




Thanks a lot for the tip Marco Dell'Oca  

It is a bit odd to confirm your own answer as best response as responses come from contributors who help.
you are right, I was wrong and I could not change the choice.
I'm sorry, how can I fix it?
I tried again but couldn't change my choice.

Endless excuses.