I have two questions related to the code below. The code currently searches a folder for all files and adds FileName,FilePath and picture to the sheet.
Question 1)
This is stupid but how do I add a If statement
to only add *.png
files to the sheet. I tried .EndsWith(".png")
but I am getting compiler error.
Question 2)
How do I change this function to search for all files, recursively?
Sub AddPicture()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim aString As String
Cells(1, 1) = "Name"
Cells(1, 2) = "Path"
Cells(1, 3) = "Picture"
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Pictures\")
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 1) = objFile.name
'print file path
Cells(i + 1, 2) = objFile.path
AddPicOverCell objFile.path, objFile.name, ActiveSheet.Cells(i + 1, 3)
Rows(i + 1).RowHeight = 85
i = i + 1
Next objFile
End Sub
Sub AddPicOverCell(path As String, filename As String, rngRangeForPicture As Range)
With Application
Dim StartingScreenUpdateing As Boolean
Dim StartingEnabledEvent As Boolean
Dim StartingCalculations As XlCalculation
StartingScreenUpdateing = .ScreenUpdating
StartingEnabledEvent = .EnableEvents
StartingCalculations = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim Top As Single, Left As Single, Height As Single, Width As Single
Dim file As String
Dim ws As Worksheet
file = path
Top = rngRangeForPicture.Top
Left = rngRangeForPicture.Left
Height = 85 'rngRangeForPicture.Height
Width = 85 'rngRangeForPicture.Width
Set ws = rngRangeForPicture.Worksheet
ws.Shapes.AddPicture file, msoCTrue, msoTrue, Left, Top, Width, Height
With Application
.ScreenUpdating = StartingScreenUpdateing
.EnableEvents = StartingEnabledEvent
.Calculation = StartingCalculations
End With
End Sub