# Pull Image from Folder



## arshab (Sep 24, 2022)

I have hundreds of images (passport size photos) in my C drive folder, every image has been assigned Number instead of name, I want some vba formula for if i write numbers in A Row it should automatically pull images from Photo folder and put in B row


----------



## Sequoyah (Sep 24, 2022)

Hi arshab,
try this code, adapt the path as needed:

```
Sub InsertPicture2()
'https://www.mrexcel.com/board/threads/pull-image-from-folder.1217415/

Const MyFolder As String = "C:\Users\Sequoyah\Desktop\Picture\" '<===== adapt the path

Dim InsPic As Picture
Dim LocationPic As String
Dim cel As Range

    For Each cel In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)

        LocationPic = MyFolder & cel.Value & ".jpg"

        With Range("B" & cel.Row)
            Set InsPic = ActiveSheet.Pictures.Insert(LocationPic)
            .RowHeight = InsPic.Height
            InsPic.Top = .Top
            InsPic.Left = .Left
            InsPic.Placement = xlMoveAndSize
        End With

    Next cel

End Sub
```


----------



## arshab (Dec 15, 2022)

Sequoyah said:


> Hi arshab,
> try this code, adapt the path as needed:
> 
> ```
> ...


----------



## arshab (Dec 15, 2022)

Sequoyah said:


> Hi arshab,
> try this code, adapt the path as needed:
> 
> ```
> ...


Hi  Sequoyah the formula you had given is working perfectly, appreciated, need one more favor, when ever I try to pull new photos it duplicates all previous photos, can you  make slight change and skip previous Numbers in column "A " which brings photo in column "B "​


----------



## Sequoyah (Dec 18, 2022)

Hi arshab,
thanks for your prompt reply , here is the updated code as per your request

```
Sub InsertPicture3()
'https://www.mrexcel.com/board/threads/pull-image-from-folder.1217415/

Const MyFolder As String = "C:\Users\39320\Desktop\Forum\Picture\" '<===== adjust the path

Dim InsPic As Picture
Dim LocationPic As String
Dim cel As Range, xRg As Range
Dim xShape As Shape
Dim xFlag As Boolean
        
    For Each cel In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    On Error Resume Next
    Set xRg = cel.Offset(0, 1)
  
    xFlag = False
    For Each xShape In ActiveSheet.Shapes
        If xShape.TopLeftCell.Address = xRg.Address Then
            xFlag = True
        End If
    Next xShape
    If xFlag Then
       ' MsgBox "Image exists!"
    Else
    LocationPic = MyFolder & cel.Value & ".jpg"
                    
        With Range("B" & cel.Row)
            Set InsPic = ActiveSheet.Pictures.Insert(LocationPic)
            .RowHeight = InsPic.Height
            InsPic.Top = .Top
            InsPic.Left = .Left
            InsPic.Placement = xlMoveAndSize
        End With
    End If
    Next cel
    
End Sub
```


----------



## arshab (Dec 18, 2022)

Sequoyah said:


> ```
> Sub InsertPicture3()
> 'https://www.mrexcel.com/board/threads/pull-image-from-folder.1217415/
> 
> ...


Thanx Bro for your prompt reply, will check the formula and get back you asap


----------

