Modifing Excel Macro VBA - inserting pictures from all subfolders after giving basic location.

%3CLINGO-SUB%20id%3D%22lingo-sub-1613244%22%20slang%3D%22en-US%22%3EModifing%20Excel%20Macro%20VBA%20-%20inserting%20pictures%20from%20all%20subfolders%20after%20giving%20basic%20location.%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1613244%22%20slang%3D%22en-US%22%3E%3CP%3EHello%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20am%20having%20trouble%20with%20editing%20this%20macro.%20Below%20you%20can%20see%20the%20one%20i%20use%20for%20getting%20pictures%20from%20a%20location.%20Now%20i%20have%20to%20change%20it%20so%20it%20also%20searches%20for%20pictures%20in%20catalogues%20withing%20the%20catalogue%20I%20give%20direction%20to.%20There%20is%20many%20of%20them%20and%20generated%20in%20different%20ways%2C%20so%20I%20can't%20predict%20their%20names.%3CBR%20%2F%3E%3CBR%20%2F%3ECan%20you%20help%20me%20add%20a%20part%20of%20code%20where%20it%20looks%20also%20in%20all%20subfolders%2C%20even%203%20levels%20deeper%3F%3CBR%20%2F%3E%3CBR%20%2F%3E%3C%2FP%3E%3CP%3E%3CEM%3ESub%20PictureInAColumnNo1()%3C%2FEM%3E%3C%2FP%3E%3CP%3E%3CEM%3EDim%20Xrange%2C%20Xcell%20As%20Range%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EDim%20PhotoPath%2C%20PhotoDirPath%2C%20Model%20As%20String%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EDim%20Cellpicture%20As%20Shape%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EDim%20PhotoObject%20As%20Object%3C%2FEM%3E%3C%2FP%3E%3CP%3E%3CEM%3EColumnInp%20%3D%20InputBox(%22A%22%2C%20%22B%22)%3C%2FEM%3E%3C%2FP%3E%3CP%3E%3CEM%3EIf%20ColumnInp%20%3D%20%22%22%20Then%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EExit%20Sub%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EElse%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EColumnMod%20%3D%20Mid(ActiveCell.Address%2C%20InStr(ActiveCell.Address%2C%20%22%24%22)%20%2B%201%2C%20InStr(2%2C%20ActiveCell.Address%2C%20%22%24%22)%20-%202)%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3ESet%20Xrange%20%3D%20ActiveSheet.Range(ColumnInp%20%26amp%3B%20ActiveCell.Row%20%26amp%3B%20%22%3A%22%20%26amp%3B%20ColumnInp%20%26amp%3B%20%2240000%22)%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EEnd%20If%3C%2FEM%3E%3C%2FP%3E%3CP%3E%3CEM%3EFor%20Each%20Xcell%20In%20Xrange%3C%2FEM%3E%3C%2FP%3E%3CP%3E%3CEM%3EXcell.Select%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3Erownum%20%3D%20ActiveCell.Row%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EOn%20Error%20Resume%20Next%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EIf%20ActiveSheet.Range(ColumnMod%20%26amp%3B%20rownum).Value%20%3D%20%22%22%20Then%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EExit%20For%3C%2FEM%3E%3CBR%20%2F%3E%3CBR%20%2F%3E%3CEM%3EEnd%20If%3C%2FEM%3E%3C%2FP%3E%3CP%3E%3CEM%3EModel%20%3D%20ActiveSheet.Range(ColumnMod%20%26amp%3B%20rownum).Value%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EPhotoPath%20%3D%20%22MY%20DIRECTORY%5CBlablabla%5C%22%20%26amp%3B%20Model%20%26amp%3B%20%22%231%22%20%26amp%3B%20%22.jpg%22%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EIf%20(PhotoPath)%20Then%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3ESet%20PhotoObject%20%3D%20CreateObject(%22WIA.Imagefile%22)%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EPhotoObject.LoadFile%20PhotoPath%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EXcell.ColumnWidth%20%3D%2020%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EXcell.RowHeight%20%3D%20110%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3ESet%20Cellpicture%20%3D%20Application.ActiveSheet.Shapes.AddPicture(PhotoPath%2C%20True%2C%20True%2C%20Columns(Xcell.Column).Left%20%2B%205%2C%20Rows(Xcell.Row).Top%20%2B%205%2C%20-1%2C%20-1)%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3ECellpicture.Width%20%3D%20100%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EElse%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EActiveCell.Value%20%3D%20%22Photo%20missing%22%3C%2FEM%3E%3CBR%20%2F%3E%3CEM%3EEnd%20If%3C%2FEM%3E%3CBR%20%2F%3E%3CBR%20%2F%3E%3CEM%3ENext%3C%2FEM%3E%3C%2FP%3E%3CP%3E%3CEM%3EEnd%20Sub%3C%2FEM%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1613244%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E
Occasional Visitor

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

 

 

0 Replies