Extract Multiple Images from Excel file to a folder

[raj2206]

Hi,I have several product catalog with product images in an excel file. I would like to extract the images in bulk with user defined file names so that I can use them in my website. Can any one help me on this one.Thanks, Raj

 

[bibleguy125]

Here is code that I have used to successfully export pictures from Excel. It's a lot more complicated than it seems it should be. This will create a chart of your picture for the specified range, then export it as a .png file. It leaves a white border and a black line around the picture. That didn't matter for my purposes, so I didn't try too hard to make it go away.

Public Function FileFolderExistsBins(strFullPath As String) As Boolean


    On Error GoTo EarlyExit
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExistsBins = True
    
EarlyExit:
    On Error GoTo 0
End Function


Sub exportPic1()
  
  Dim picRange As Range
  Dim picChart As Chart
  Dim name1 As String
  
  Set picRange = Range("C2:H23")
  
 name1 = "filename" & ".png"  
  
'Check to see if file already exists, if so deletes it so new file can be saved
    If FileFolderExistsBins(name1) Then
    Kill (name1)
    Else
    End If
    
 'Creates a chart and pastes the image in it
  
  
  Set picChart = ActiveSheet.ChartObjects.Add(Left:=0, _
      Top:=picRange.Top + picRange.Height + 10, _
      Width:=picRange.Width, Height:=picRange.Height).Chart
  
  With ActiveSheet.Shapes(picChart.Parent.name)
    .Fill.Visible = msoFalse
    .Line.Visible = msoFalse
  End With
  
  picRange.CopyPicture xlScreen, xlPicture
  
  picChart.Paste
  
  'Exports picture to file
  picChart.Export Filename:=name1, Filtername:="png"
  
    'Deletes Chart from sheet
    Dim wsItem As Worksheet
    Dim chtObj As ChartObject
     
    For Each wsItem In ThisWorkbook.Worksheets
         
        For Each chtObj In wsItem.ChartObjects
             
            chtObj.Delete
             
        Next
         
    Next
  
  Application.ScreenUpdating = True


  End If
End Sub

 

[raj2206]

Hi bibleguy125, Thanks for the codes and quick response and apologies for my late response. I am not very good at VBA, but copy pasted the codes and tried to run it, but I was not able to get the result. It would be great if you could explain me the steps to get the desired results since I am confused with the steps to be followed. Also while running the codes, there was an error pop-up for incomplete "IF Statement".

Also I hope I am clear with my desired result, please revert back to me in case you need more clarifications from my end.

Cheers !!
Raj
Passion for Excel !!

 

[bibleguy125]

Sorry for taking a while to respond. I forgot to take out the other End If at the end of the code, the code I took it from had some other things going on as well. See if this helps:

Sub exportPicture()
  
  Dim oRange As Range
  Dim oCht As Chart
  Dim oImg As Picture
  Dim name1 As String
  
  Application.ScreenUpdating = False


  'Create file name
 
  name1 = "full path & filename" & ".png"   '|||||||||||||||||||||enter the full name and filepath
                                            
  
'Check to see if file already exists, if so deletes it so new file can be saved
    If FileFolderExists(name1) Then
    Kill (name1)
    Else
    End If


 'Creates a chart and pastes the image in it
  Set oRange = Range("B3:D9")   '|||||||||||||||||||||This is what range your picture will be in.
  
  Set oCht = ActiveSheet.ChartObjects.Add(Left:=0, _
      Top:=oRange.Top + oRange.Height + 10, _
      Width:=oRange.Width, Height:=oRange.Height).Chart
  
  With ActiveSheet.Shapes(oCht.Parent.Name)
    .Fill.Visible = msoFalse
    .Line.Visible = msoFalse
  End With
  
  oRange.CopyPicture xlScreen, xlPicture
  
  oCht.Paste
  
  'Exports
  oCht.Export Filename:=name1, Filtername:="png"
  
    'Deletes Chart from sheet
    Dim wsItem As Worksheet
    Dim chtObj As ChartObject
     
    For Each wsItem In ThisWorkbook.Worksheets
         
        For Each chtObj In wsItem.ChartObjects
             
            chtObj.Delete
             
        Next
         
    Next
  
  Application.ScreenUpdating = True


End Sub

If you have other questions let me know. Took me a while to figure this out.

 

[bibleguy125]

By the way, this code is for one image at a time. There is no reason you can't copy this code multiple times to run one macro and export multiple images at once. I will play with exporting a selection and see what I come up with.

 

[bibleguy125]

This code will export whatever range is selected as a .png file. All that was added to the code was that the range for oRange is now Selection and there is a With ActiveChart/End With right after that

Sub exportPicture()
  
  Dim oRange As Range
  Dim oCht As Chart
  Dim oImg As Picture
  Dim name1 As String
  
  
  Application.ScreenUpdating = False


  'Create file name
 
  name1 = "full path & filename" & ".png"   '|||||||||||||||||||||enter the full name and filepath
  
'Check to see if file already exists, if so deletes it so new file can be saved
    If FileFolderExists(name1) Then
    Kill (name1)
    Else
    End If


 'Creates a chart and pastes the image in it
  'Set oRange = Range("B3:D9")   '|||||||||||||||||||||This is what range your picture will be in.
  
  Set oRange = Selection
  
  With ActiveChart
  Set oCht = ActiveSheet.ChartObjects.Add(Left:=0, _
      Top:=oRange.Top + oRange.Height + 10, _
      Width:=oRange.Width, Height:=oRange.Height).Chart
  End With
  
  With ActiveSheet.Shapes(oCht.Parent.Name)
    .Fill.Visible = msoFalse
    .Line.Visible = msoFalse
  End With
  
  oRange.CopyPicture xlScreen, xlPicture
  
  oCht.Paste
  
  'Exports
  oCht.Export Filename:=name1, Filtername:="png"
  
    'Deletes Chart from sheet
    Dim wsItem As Worksheet
    Dim chtObj As ChartObject
     
    For Each wsItem In ThisWorkbook.Worksheets
         
        For Each chtObj In wsItem.ChartObjects
             
            chtObj.Delete
             
        Next
         
    Next
  
  Application.ScreenUpdating = True


End Sub

 

[bibleguy125]

I guess the only hitch to this is you have to select a range, it will not export selected pictures, only what is in a selected range. That said, you can put whatever you want inside that range and it becomes a part of the image. I use this method to make maps for work with labels and arrows, etc. made with Excel.

 

[appcraze]

I guess the only hitch to this is you have to select a range, it will not export selected pictures, only what is in a selected range. That said, you can put whatever you want inside that range and it becomes a part of the image. I use this method to make maps for work with labels and arrows, etc. made with Excel.

For full automation have a look at Picture Manager for Excel