Hej,
behöver hjälp med ett script som sorterar in bilder från vår webbkamera i olika kataloger . Strukturen bör vara indelad i år/månad/vecka (alternativt till vecka är dagar enl. 0-10 11-20 21-31).

Bilderna sparas idag ner i en och samma katalog och har namn enligt 050526202900.jpg dvs år|mån|dag|h|min|sec|.jpg

Idag ligger det ca 314000 (!) bilder i samma katog på en XP maskin och det hanterar inte systemet... Vi skapar väderfilmer av bilderna så vi vill spara allt material vi har. DVD brännarprogrammet gillar inte heller antalet filer i samma katalog så det skulle vara bra att städa upp lite. Har tänkt köra scriptet via schemaläggaren.

Tacksam för all hjälp.
/S.S

Ingen fullständig lösning men en början:

<code=vb>
Sub MoveAllFiles(OrigFolderName, NewFolder)
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim File
For Each File In fso.GetFolder(OrigFolderName).Files
Dim Year, Month, Week, Path
' Extrahera år-mån-vecka
Year = "20" & Left(File.Name, 2)
Month = Mid(File.Name, 4, 2)
Week = Str(Val(Mid(File.Name, 8, 2)) \ 7)
' Kolla att alla underkataloger finns
Path = NewFolder & "/" & Year
If Not fso.FolderExists(Path) Then fso.CreateFolder Path
Path = Path & "/" & Month
If Not fso.FolderExists(Path) Then fso.CreateFolder Path
Path = Path & "/" & Week
If Not fso.FolderExists(Path) Then fso.CreateFolder Path
fso.MoveFile File, Path & "/" & File.Name
Next
End Sub
</code>

Jag skulle angripa problemmet så här.
Idag är det 38741. Om det då finns fler samma dag skulle det kunna bli 38741_3.jpg
38741 är antal dagar sedan 1900-01-01.
Sedan kan man sätta in ett "Cut" efter varje 365 ökning och lägga i sin mapp
38741 kan du lätt omvandla till aptitligare format om du vill med tex.
Tal som 38741 är ju mycket lätt att hantera sorteringsmässigt därför detta mellansteg.
<code>
MsgBox Format$(38741,"yyyy-mm-dd_3.jpg")
</code>
<code>
Option Explicit
Private Sub Command1_Click()
Dim Nu As Long
Nu = CDate(Date)
MsgBox Nu
End Sub
</code>
<b>Vid närmare eftertanke vill du nog ha det så här.</b>
<code>
Option Explicit
Private Sub Command1_Click()
Dim Nu As Double, save As String
Nu = CDate(Now)
MsgBox Nu
'Spara till mapp enl
save = Format$(Nu, "yyyy-mm-dd_hh-mm-ss.jpg")
'Test på ut .jpg
MsgBox save
End Sub
</code>
<b>Tycker ditt problem är intressant , lagom terapi för hjärnan.
hjälper dig gärna att få ihop det snyggt och funktionelt ang sortering och
sortering i mappar. En mapp/ett år blir nog bra.
050526202900.jpg är ju lätt som en plätt att sortera i mindre delar.</b>

Intressant idé! Måste testa det här.

Blev den här varianten tillsvidare:

Skulle vilja köra som script men vet inte hur jag ska lösa funktionen Format
<code>
Dim OrigFolderName, NewFolder
Call MoveAllFiles(OrigFolderName, NewFolder)

Sub MoveAllFiles(OrigFolderName, NewFolder)
OrigFolderName = "\\datornamn\c$\sequential"
NewFolder = "\\datornamn\c$\bildarkiv"
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim File
Dim Antal
Antal = 0
For Each File In fso.GetFolder(OrigFolderName).Files
Dim Year, Month, Week, theDay, Path

' Extrahera år-mån-vecka
'filnamn typ 05|05|26|20|34|00.jpg
'filnamn typ år/mån/dag/h/min/sec/
Year = "20" & Left(File.Name, 2)


Month = Mid(File.Name, 3, 2)

theDay = Mid(File.Name, 5, 2)

Week = Format(Year & "." & Month & "." & theDay, "ww")
' Kolla att alla underkataloger finns
Path = NewFolder & "/" & Year
If Not fso.FolderExists(Path) Then fso.CreateFolder Path
Path = Path & "/" & Month
If Not fso.FolderExists(Path) Then fso.CreateFolder Path
Path = Path & "/" & Week
If Not fso.FolderExists(Path) Then fso.CreateFolder Path
fso.MoveFile File, Path & "/" & File.Name
Antal = Antal + 1
Next
MsgBox "Hanterat" & " " & Antal & " " & "filer"


End
End Sub
</code>

DatePart() funktionen borde finnas i script

Option Explicit

Const OrigFolderName = "C:\temp\MoveAllFiles"
Const NewFolder = "C:\temp\MoveAllFiles"

Call MoveAllFiles(OrigFolderName, NewFolder)

Function NameToPath(FileName)
Dim FileYear
Dim FileMonth
Dim FileDay
Dim FileWeek
Dim FileDate
    
    FileYear = 2000 + CLng(Mid(FileName, 1, 2))
    FileMonth = CLng(Mid(FileName, 3, 2))
    FileDay = CLng(Mid(FileName, 5, 2))
    
    FileDate = DateSerial(FileYear, FileMonth, FileDay)
    FileWeek = DatePart("ww", FileDate, vbUseSystemDayOfWeek, 

vbUseSystem)
    
    NameToPath = FileYear & "/" & FileMonth & "/" & FileWeek

End Function

' Kolla att alla underkataloger finns
Sub CreateFolder(fso, Path)
    If Not fso.FolderExists(Path) Then
        CreateFolder fso, fso.GetParentFolderName(Path)
        fso.CreateFolder Path
    End If
End Sub

Sub MoveAllFiles(OrigFolderName, NewFolder)
Dim fso
Dim File
Dim Antal
Dim Path
    Antal = 0
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each File In fso.GetFolder(OrigFolderName).Files
	If IsNumeric(Left(File.Name, 4)) Then
            Path = NewFolder & "\" & NameToPath(File.Name)
        
            ' Kolla att alla underkataloger finns
            CreateFolder fso, Path
        
            File.Move Path & "\" & File.Name
        
            Antal = Antal + 1
        End If
    Next
    MsgBox "Hanterat" & " " & Antal & " " & "filer"
End Sub

Hej. Tack! Det löste problemet med sorteringen! Ska försöka att lägga in ett filter att scriptet skippar filer som är skapade inom de senaste 24h men sen är jag nöjd :)

/S.S

Oki Andreas kod är proffsig.
Men kan inte låta bli att tycka att det är "OverKill" i just detta exempel.
Som matematiskt lagd tycker jag om att betrakta dagens datum som 38747

Datum$ = Format$(38747,"yyyy-mm-dd")

Det låter intressant. Hur kan man uttnytja datum som tal i detta exemplet?