Sammensætte filnavn og foldernavn

Med lidt løkke-værk skulle det være klaret.

Du kan vist finde alle stupmerne på eksperten (fx. ved at omskrive en fil-søgnings-rutine), og så sætte dem sammen til noget du kan bruge. Har ikke lige tiden selv

Denne her sku klare ærterne, bare kald FindDirs med "H:\test" som lPath...


Private Sub FindDirs(lPath As String)
Dim i As Long
Dim lDir As String
Dim lDirs() As String, nFile As Long
   
    If Right(lPath, 1) <> "\" Then lPath = lPath & "\"
   
    lDir = Dir(lPath & "*.", vbDirectory)
    Do While lDir <> ""
        If lDir <> "." And lDir <> ".." Then
            If GetAttr(lPath & lDir & "\") And vbDirectory = vbDirectory Then
                ReDim Preserve lDirs(nFile)
                lDirs(nFile) = lDir
                nFile = nFile + 1
            End If
        End If
        lDir = Dir
    Loop
   
    For i = 0 To nFile - 1
        FindAndMoveFiles lDirs(i), lPath
    Next

End Sub

Private Sub FindAndMoveFiles(lPath As String, MasterDir As String)
Dim lFile As String
Dim fs As Object

    Set fs = CreateObject("Scripting.FileSystemObject")

    lFile = Dir(MasterDir & lPath & "\*.*")
    Do While lFile <> ""
        If lFile <> "." And lFile <> ".." Then
            fs.movefile MasterDir & lPath & "\" & lFile, MasterDir & lPath & " - " & lFile
        End If
        lFile = Dir
    Loop
   
End Sub