08-26-2020 04:50 AM
Hello,
I am having trouble with editing this macro. Below you can see the one i use for getting pictures from a location. Now i have to change it so it also searches for pictures in catalogues withing the catalogue I give direction to. There is many of them and generated in different ways, so I can't predict their names.
Can you help me add a part of code where it looks also in all subfolders, even 3 levels deeper?
Sub PictureInAColumnNo1()
Dim Xrange, Xcell As Range
Dim PhotoPath, PhotoDirPath, Model As String
Dim Cellpicture As Shape
Dim PhotoObject As Object
ColumnInp = InputBox("A", "B")
If ColumnInp = "" Then
Exit Sub
Else
ColumnMod = Mid(ActiveCell.Address, InStr(ActiveCell.Address, "$") + 1, InStr(2, ActiveCell.Address, "$") - 2)
Set Xrange = ActiveSheet.Range(ColumnInp & ActiveCell.Row & ":" & ColumnInp & "40000")
End If
For Each Xcell In Xrange
Xcell.Select
rownum = ActiveCell.Row
On Error Resume Next
If ActiveSheet.Range(ColumnMod & rownum).Value = "" Then
Exit For
End If
Model = ActiveSheet.Range(ColumnMod & rownum).Value
PhotoPath = "MY DIRECTORY\Blablabla\" & Model & "#1" & ".jpg"
If (PhotoPath) Then
Set PhotoObject = CreateObject("WIA.Imagefile")
PhotoObject.LoadFile PhotoPath
Xcell.ColumnWidth = 20
Xcell.RowHeight = 110
Set Cellpicture = Application.ActiveSheet.Shapes.AddPicture(PhotoPath, True, True, Columns(Xcell.Column).Left + 5, Rows(Xcell.Row).Top + 5, -1, -1)
Cellpicture.Width = 100
Else
ActiveCell.Value = "Photo missing"
End If
Next
End Sub