File namen uit lezen met extensie JPG uit pad opgegeven in Cel b2

[caffie]

ik heb de volgde code gekregen en het path flexibel gemaakt door deze in B2 uit te lezen
nu zou ik graag de code aanpassen zodat deze enkel de file(s) met de extensie JPG inlees (ophaal)

Sub LoopThroughFiles()
Dim x As Integer

x = 4
    Dim MyObj As Object, MySource As Object, file As Variant
   
   file = (Dir(Cells(2, 2).Value))
   While (file <> "")

      If InStr(file, "test") > 0 Then
         MsgBox "found " & file
         Exit Sub
      End If
     file = Dir
     Cells(x, 2) = file
     x = x + 1
  Wend
End Sub

Ik weet niet of me excel sheet toevoegen hier een meer waarde heeft.

 

[snb]

Ha, Code van de vorige eeuw.

 

[edmoor]

Iets jonger:

Sub GetFilenames()
    Files = Split(CreateObject("WScript.Shell").Exec("cmd /c dir /b " & Range("B2") & "\*.jpg*").StdOut.ReadAll, vbCr)
    With Range("A1:A" & UBound(Files))
        .Value = Application.Transpose(Files)
        .WrapText = False
    End With
    Columns.AutoFit
End Sub

 

[caffie]

Werkt niet

ik heb de code gekopieerd en geplakt maar het werkt niet.

in cel staat staat het path als "D:\prive\cv ketel"


De files die uitgelezen moeten worden hebben de
2023-09-07 - 2224.JPG

datum + 4 cijfercode.jpg

 

[edmoor]

Dat komt door die spatie in cv ketel.
Maak er dan dit van:

Sub GetFilenames()
    Files = Split(CreateObject("WScript.Shell").Exec("cmd /c dir /b " & """" & Range("B2") & """" & "\*.jpg*").StdOut.ReadAll, vbCr)
    With Range("A1:A" & UBound(Files))
        .Value = Application.Transpose(Files)
        .WrapText = False
    End With
    Columns.AutoFit
End Sub

NB:
Melden dat iets niet werkt is wel erg kort door de bocht.
Vertel er dan ook bij of je een foutmelding krijgt en welke dat dan is.

 

[caffie]

Opgelost

Sorry nog een keer gedaan
Er stond een oude macro nog aan
Was dus mijn fout

Heel erg bedankt voor de code
Ga er mee stoeien.