Telefonszámunk: 1-472-0679

Hozzászólás: [Resolved] Kép beillesztése fájlba, választott almappából minden képet

Kezdőlap Fórumok Excel programozás [Resolved] Kép beillesztése fájlba, választott almappából minden képet Hozzászólás: [Resolved] Kép beillesztése fájlba, választott almappából minden képet

#10338
horvimi
Adminisztrátor

    Szia!

    Erre a feladatra rekurzív algoritmust szoktak használni, ami saját magát hívja meg, amíg talál alkönytárat.
    Ehhez úgy láttam, hogy legtöbbször az FSO objektumot használják.
    Én erről az oldalról vettem egy mintát:
    https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/
    A konkrét megoldás:
    Using File System Object (FSO) Late Binding – Method #2
    Két Sub van benne. Az első csak egy felkészülés, adatok és pozíciók megadása, a második az, ami a rekurzió.
    Egy kicsit hozzányúltam, hogy az első sub-ban megadott mappát vegye kiindulásnak, és az aktuális munkalapon az A1-es cellától lefelé, egymás alá listázza a mappa és almappák fájl útvonalait.
    Ott nyúltam hozzá ahol magyar kommentet látsz.

    Sub loopAllSubFolderSelectStartDirectory()
    
    Dim FSOLibrary As Object
    Dim FSOFolder As Object
    Dim folderName As String
    
    'Set the folder name to a variable
    folderName = "C:\Users\DELL\Documents\NovoData-Word-Excel\"
    
    'Set the reference to the FSO Library
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    
    'Az aktuális munkalap A1-es cellájától írja ki a fájlok útvonalait
    'Elsőként törli az ott lévő tartalmat
    Range("A1").Select
    ActiveCell.CurrentRegion.Clear
    
    'Another Macro must call LoopAllSubFolders Macro to start
    LoopAllSubFolders FSOLibrary.GetFolder(folderName)
    
    End Sub
    
    'Don’t run the following macro, it will be called from the macro above
    
    Sub LoopAllSubFolders(FSOFolder As Object)
    
    Dim FSOSubFolder As Object
    Dim FSOFile As Object
    
    'For each subfolder call the macro
    For Each FSOSubFolder In FSOFolder.subfolders
        LoopAllSubFolders FSOSubFolder
    Next
    
    'For each file, print the name
    For Each FSOFile In FSOFolder.Files
    
        'Insert the actions to be performed on each file
        
        'Az aktuális cellába beírja az aktuális fájl útvonalát
        'Majd lép  akövetkező sorba
        ActiveCell.Value = FSOFile.Path
        ActiveCell.Offset(1, 0).Select
    
    Next
    
    End Sub

    Ha bemásolod egy modulba, majd az első sub-ban megváltoztatod a gyökér mappát, utána futtathatod.
    A többi már összerakható az eredeti kódod alapján.

    Imre