Add every file inside a folder

DanoTheKid

New Member
Joined
Feb 23, 2020
Messages
6
Office Version
2016
Platform
Windows
Hello, I'm trying to do a macro that let's the user select a folder with more folders inside, this folders could have images .jpg or .png. What I want is that the macro adds only the image files in the excel, any image file. What it does right now is that adds the images but only if they have for name 1.jpg, 2.jpg, 3.jpg and so on.

VBA Code:
   Dim Secfolder As String
    MsgBox ("Busque y seleccione la carpeta que contiene las carpetas de los sectores en el punto que realizará.")
    With Application.FileDialog(msoFileDialogFolderPicker)
    
    .Title = "Buscar carpeta"
    .ButtonName = "Aceptar"
    .InitialFileName = "C:\"
    
    If .Show = -1 Then
     Secfolder = .SelectedItems(1)
    End If
    
    Sheets("Matriz_de_Hallazgos").Select
    
    l = 1
    
    For i = 1 To 200
    idm = (Worksheets("Matriz_de_Hallazgos").Cells(i + 2, 1))
    
    If idm = 1 Then
    Application.SpellingOptions.IgnoreCaps = True
     ' Colocar la ruta de las fotos; las fotos deben llamarse como números. Ej: 1.jpg'
        RutaCompleta = Secfolder & "\" & "sector " & idm & "\" & l & ".jpg"
        ActiveSheet.Cells(i + 2, 3).Select
        With ActiveSheet.Shapes.AddPicture(Filename:=RutaCompleta, linktofile:=msoFalse, _
            SaveWithDocument:=msoCTrue, Left:=0, Top:=0, Width:=0, Height:=0)
            .LockAspectRatio = 0
            .Top = ActiveCell.Top
            .Left = ActiveCell.Left
            .Width = ActiveCell.Width
            .Height = ActiveCell.Height
        End With
        l = l + 1
    End If
    Next i
Any ideas? Thank you
 

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,057
Office Version
365
Platform
Windows
Function searches for filename with both extensions ( jpg and png )

If neither file exists then an EMPTY string is returned
If jpg is found : jpg file path is returned
If jpg not found: if png is found png file path is returned

VBA Code:
'REPLACE
RutaCompleta = Secfolder & "\" & "sector " & idm & "\" & l & ".jpg"

'WITH
RutaCompleta = GetFilePath(Secfolder & "\" & "sector " & idm & "\" & l)
Debug.Print RutaCompleta
and insert this function in the same module as your code
VBA Code:
Private Function GetFilePath(fPath As String) As String
    Dim jpg As String, png As String
    On Error Resume Next
        jpg = Dir(fPath & ".jpg")
        png = Dir(fPath & ".png")
    On Error GoTo 0
    If Len(jpg) > 0 Then
        GetFilePath = jpg
    ElseIf Len(png) > 0 Then
        GetFilePath = png
    End If
End Function
Debug.Print
Debug.Print writes the found path to the Immediate Widow, which is useful when testing
Display the Immediate Window In VBA editor with {CTRL} g
After testing you can delete line containing Debug.Print

Note :
To prevent your code failing, I recommend that you amend your code to handle the situation where neither file is found
.
.
.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,684
Messages
5,470,120
Members
406,681
Latest member
sachinmasurkar

This Week's Hot Topics

Top