0

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
pnuts
  • 58,317
  • 11
  • 87
  • 139
theAlse
  • 5,577
  • 11
  • 68
  • 110

0 Answers0