VBA i access 97

Du er nødt til først at lægge foldernavnene ind i et array:

Dim StartFolder as String
Dim StartFolder as String
Dim FolderNavn(1 to 100) as String
Dim I as Integer

StartFolder = "D:\billeder\SZ4\"
Folder = Dir(StartFolder, vbDirectory)
I = 0
Do While Folder <> ""   
    ' Ignorer det aktuelle bibliotek og det overordnede bibliotek.
    If Folder <> "." And Folder <> ".." Then
        ' Brug bitvis sammenligning til at sikre, at Folder er et bibliotek.
        If (GetAttr(StartFolder & Folder) And vbDirectory) = vbDirectory Then
            I=I 1
            FolderNavn(I) = Folder
        End If
    End If
    Folder = Dir    ' Hent næste folder
Loop

Og så kan du så køre resten af dit program. Du kan ikke lægge dit program ind i denne løkke, da den vil forstyrre brugen af dir-sætningen.

hvordan ser det så ud samlet på en folder hedder :

D:\billeder\SZ4\
D:\billeder\SZ4\test1\
D:\billeder\SZ4\test2\

hvor billederne ønskes samlet i én resulterende folder som hedder D:\billeder_godkendte\

Jeg har prøvet mit bedste. Det er lidt uoverskueligt et det her lille vindue på Eksperten. Om ikke andet så håber jeg du kan bruge det som inspiration.

Function kopier()
Dim db As Database
Dim rs As DAO.Recordset
Dim n As Long
Dim StartFolder as String
Dim FolderNavn(1 to 100) As String
Dim I As Integer
Dim FolderAntal As Integer

StartFolder = "D:\billeder\SZ4\"
Folder = Dir(StartFolder, vbDirectory)
I = 0
Do While Folder <> ""   
    If Folder <> ".." Then  ' Ignorer det overordnede bibliotek.
        If (GetAttr(StartFolder & Folder) And vbDirectory) = vbDirectory Then
            I=I+1
            FolderNavn(I) = Folder
        End If
    End If
    Folder = Dir    ' Hent næste folder
Loop
FolderAntal=I

Set db = CurrentDb
Set rs = db.OpenRecordset("table1", dbOpenSnapshot)
rs.MoveLast
For I= 1 to FolderAntal
    rs.MoveFirst
    For n = 1 To rs.RecordCount
        If Dir(FolderNavn(I) & rs![field1]) <> "" Then
            FileCopy FolderNavn(I) & rs![field1], "D:\billeder_ok\SZ4\" & rs![field1]
        End If
        rs.MoveNext
    Next n
Next I

rs.Close
Set rs = Nothing
db.Close
End Function

jeg accepterer og tester senere da jeg ikke når de de næste par dage.
Jeg vender tilbage uanset hvad således du har en status.

Takker foreløbig.

OK - og tak for orienteringen (den er det mange der glemmer).  ;-)

Jeg har ændret nogle stier i DIR referencen, men når scriptet køres kopieres der aldrig en fil ?!?...

Det er som om den ikke kan finde ud af det med foldernavn\filnavn

nogle hurtige ideer??

ups .. her er scriptet..

Function kopier()
Dim db As Database
Dim rs As DAO.Recordset
Dim n As Long
Dim StartFolder As String
Dim Folder As String
Dim FolderNavn(1 To 1000) As String
Dim I As Integer
Dim FolderAntal As Integer

StartFolder = "D:\billeder\"
Folder = Dir(StartFolder, vbDirectory)
I = 0
Do While Folder <> ""
    If Folder <> ".." Then  ' Ignorer det overordnede bibliotek.
        If (GetAttr(StartFolder & Folder) And vbDirectory) = vbDirectory Then
            I = I + 1
            FolderNavn(I) = Folder
        End If
    End If
    Folder = Dir    ' Hent næste folder
Loop
FolderAntal = I

Set db = CurrentDb
Set rs = db.OpenRecordset("table1", dbOpenSnapshot)
rs.MoveLast
For I = 1 To FolderAntal
    rs.MoveFirst
    For n = 1 To rs.RecordCount
        If Dir(FolderNavn(I) & rs![Name]) <> "" Then
            FileCopy "FolderNavn(I)" & rs![Name], "D:\total\" & rs![Name]
        End If
        rs.MoveNext
    Next n
Next I

rs.Close
Set rs = Nothing
db.Close
End Function

Jeg har valgt at spørge påny i dette

http://www.eksperten.dk/spm/351685