Using VBA to pull images from folder to sheet

linkjg

New Member
Joined
Dec 21, 2020
Messages
3
Office Version
  1. 2007
Platform
  1. Windows
Hello,

I have a folder on my desktop with about 400 jpgs. The images are labeled with numerals like "1.jpg" "2.jpg" "3.jpg" etc.

Is there a VBA function that would extract the file name and pictures and put them into an Excel worksheet? Could the cell with the picture be formatted to fit within the cell?

Example of output

A1: Name / B1: Picture
A2: 1 B2: Image of 1.jpg
A3: 2 B3: Image of 2.jpg
A4: 3 B4: Image of 3.jpg

Thank you for your help!


 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,835
Office Version
  1. 2010
Platform
  1. Windows
Try this:

VBA Code:
Sub insert_pictures()
    
    Const factor = 0.9  'picture is 90% of the size of cell

    'Variable Declaration
    Dim fsoLibrary As FileSystemObject
    Dim fsoFolder As Object
    Dim sFolderPath As String
    Dim sFileName As Object
    Dim p As Object

    Dim i As Long   'counter
    Dim last_row As Long
    Dim ws As Worksheet

        sFolderPath = "C:\Users\me\Desktop"  'may need to change this line to suit your situation

    
    'Set all the references to the FSO Library
    Set fsoLibrary = CreateObject("Scripting.FileSystemObject")
    Set fsoFolder = fsoLibrary.GetFolder(sFolderPath)
    Set ws = ThisWorkbook.Sheets("Sheet1")
    On Error Resume Next
    
    With ws
        .Range("A1") = "Name"
        .Range("B1") = "Picture"
    
        'Loop through each file in a folder
        i = 2
        For Each sFileName In fsoFolder.Files
            .Cells(i, 1) = Left(sFileName.Name, InStr(sFileName.Name, ".") - 1)
            i = i + 1
            '        Debug.Print sFileName.Name
        Next sFileName
        
        last_row = i
        
        Range(.Cells(2, 1), .Cells(i, 1)).Sort key1:=.Cells(2, 1), order1:=xlDescending
    
        For i = 2 To last_row Step 1
    
            Set p = .Shapes.AddPicture(Filename:=sFolderPath _
                & Cells(i, 1).Value & ".jpg", LinkToFile:=False, SaveWithDocument:=True, _
                Left:=.Cells(i, 2).Left, Top:=Cells(i, 2).Top, Width:=-1, Height:=-1)

            p.Width = .Cells(i, 2).Width * factor
            'adjust row height
            If .Cells(i, 2).RowHeight < p.Height / factor Then
                .Cells(i, 2).RowHeight = p.Height / factor
            End If

            p.Left = .Cells(i, 2).Left + (.Cells(i, 2).Width - p.Width) / 2
            p.Top = .Cells(i, 2).Top + (.Cells(i, 2).Height - p.Height) / 2
            Next i
        End With
    
    'Release the memory
    Set fsoLibrary = Nothing
    Set fsoFolder = Nothing

End Sub
 

linkjg

New Member
Joined
Dec 21, 2020
Messages
3
Office Version
  1. 2007
Platform
  1. Windows
Thank you for your help! When I insert the code and run it, I am getting a "user-defined type not defined" error. I am using Excel 2007. Is there a way I can fix?
 

Attachments

  • error.JPG
    error.JPG
    42.8 KB · Views: 16

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,835
Office Version
  1. 2010
Platform
  1. Windows
Not sure about Excel 2007. In 2010, I went to Developer/Visual Basic, then Tools/References... and added Microsoft Scripting Runtime library.
 

Attachments

  • scripting.jpg
    scripting.jpg
    71.1 KB · Views: 30

linkjg

New Member
Joined
Dec 21, 2020
Messages
3
Office Version
  1. 2007
Platform
  1. Windows
Thank you! Worked perfectly after selecting the Microsoft Scripting Runtime library. Thanks so much!
 

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,835
Office Version
  1. 2010
Platform
  1. Windows
Glad to be able to help and thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,859
Messages
5,627,290
Members
416,236
Latest member
Lynchbox

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top