Flytning af filer

Nu kan jeg ikke lige huske så meget Visual Basic, så du må selv finde de korrekte kommandoer. Men metoden, i pseudokode:

str array indienfiler 'med plads til navnet på hver fil i in folderen.

funktion gennemsøg indienmappe(sti)
    hent filer og mapper i (sti)
    for hver mappe(gennemsøg indienmappe(sti+mappe))
    for hver fil(læg filnavnet i indienfiler)
slut funktion

gennemsøg indienmappe("c:\in\")

funktion gennemsøg danmarkmappe(sti)
    hent filer og mapper i ("c:\dk\"+sti)
    for hver mappe(gennemsøg danmarkmappe(sti+mappe))
    for hver fil(
        hvis(filnavnet er i indienfiler)( 'note som det er skrevet her skal du trawle hele indienfiler igennem for hver fil i dk mappen, det bliver til nogle millioner gange i alt, men jeg tror ikke at det er noget problem i dette tilfælde, ellers skal der laves et indekseringssystem.
            kopier fil til "c:\uk\"+sti+filnavn
        )
    )
slut funktion

gennemsøg danmarkmappe("")

Jeg håber at du kan forstå min pseudokode, ellers må jeg jo i gang med noget rigtigt VB.

Hele pointen her er rekursive funktioner som kalder sig selv, det er klart den letteste måde at gennemsøge en træstruktur på.

Det lyder rigtigt nok tror jeg.. har ikke selv den store forstand på emnet :) ..

er kommet frem med denne løsning
Sub SrchForFiles()
        Dim i As Long, z As Long, Rw As Long
    Dim ws As Worksheet
    Dim y As Variant
    Dim fLdr As String, fil As String, FPath As String
    Dim MyTempList As Variant
    Dim MyTempList2 As Variant
    Dim lfldrnm As Integer
    Dim FldrName As String
    Dim FilName As String
    Dim sTmp As String
    Dim t As Long
    Dim l As Variant
    Dim ll As Variant
    Dim filell As String
    Dim p As String
   
    Range("A2:A36").Select
    Selection.ClearContents
   
    With Application.FileDialog(msoFileDialogFilePicker)
    .Show
    l = .SelectedItems(1)
    End With
                MyTempList2 = Split(l, "\")
                        For t = 0 To UBound(MyTempList2)
                        Next t
                Filenamel = MyTempList2(UBound(MyTempList2))
   
    y = Filenamel
    Application.ScreenUpdating = False

    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\test\DK"
        .SearchSubFolders = True
        .Filename = y
     
      On Error GoTo 0
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                fil = .FoundFiles(i)
                    'Get file path from file name
                    MyTempList = Split(fil, "\")
                        For t = 0 To UBound(MyTempList)
                        Next t
                    Filename = MyTempList(UBound(MyTempList))
                MyTempList(2) = "UK"
            Next i
        End If
    End With
For i = 0 To UBound(MyTempList) - 1 Step 1
Cells(i + 2, 1).Value = MyTempList(i)
Next i


    Dim Fold As String
    Dim reason As String
    Fold = Range("b2").Value
   
    Select Case Fold
   
    Case 3
    Cells(2, 3).Value = MyTempList(0) & "\" & MyTempList(1) & "\" & MyTempList(2) & "\"
   
    Case 4
    Cells(2, 3).Value = MyTempList(0) & "\" & MyTempList(1) & "\" & MyTempList(2) & "\" & MyTempList(3) & "\"
   
    Case 5
    Cells(2, 3).Value = MyTempList(0) & "\" & MyTempList(1) & "\" & MyTempList(2) & "\" & MyTempList(3) & "\" & MyTempList(4) & "\"
   
    Case 6
    Cells(2, 3).Value = MyTempList(0) & "\" & MyTempList(1) & "\" & MyTempList(2) & "\" & MyTempList(3) & "\" & MyTempList(4) & "\" & MyTempList(5) & "\"
   
    Case 7
    Cells(2, 3).Value = MyTempList(0) & "\" & MyTempList(1) & "\" & MyTempList(2) & "\" & MyTempList(3) & "\" & MyTempList(4) & "\" & MyTempList(5) & "\" & MyTempList(6) & "\"
   
    Case 8
    Cells(2, 3).Value = MyTempList(0) & "\" & MyTempList(1) & "\" & MyTempList(2) & "\" & MyTempList(3) & "\" & MyTempList(4) & "\" & MyTempList(5) & "\" & MyTempList(6) & "\" & MyTempList(7) & "\"
    End Select

    p = Cells(2, 3).Value

    Dim fso
    Dim fol As String
    fol = p ' change to match the folder path
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(fol) Then
        fso.CreateFolder (fol)
    Else
        'MsgBox fol & " already exists!", vbExclamation, "Folder Exists"
    End If
   

    Dim file As String, sfol As String, dfol As String
    file = y ' change to match the file name
    sfol = "C:\test\" ' change to match the source folder path
    dfol = p ' change to match the destination folder path
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(sfol & file) Then
  ' MsgBox sfol & file & " does not exist!", vbExclamation, "Source File Missing"
    ElseIf Not fso.FileExists(dfol & file) Then
    fso.MoveFile (sfol & file), dfol
    Else
    'MsgBox dfol & file & " already exists!", vbExclamation, "Destination File Exists"
End If

End Sub


men løber ind i problemmer når jeg skal oprette mere end en mappe. nogen forslag

fandt en løsning med at kopier mappe strukturen først og derefter slette alle filer i den..