2013-09-25, 03:09
I have this VBScript (yes im a Windows man)
I hate Renaming Sorting files so I wrote the Below Script to put My Photos into a Folders Base on Year - Month of when the photo was taken
month name is wriiten by 1 jan (so it sorts it right)
Which read a MemStrick (base on its Drive Name ) and Copy them to Said path
Wife Said " Why do you have to exit XBMC to upload the Photos"
Good Point Dear
So I would Like HEAPS of Help in changing it to phyton
starting with Step1 on Loading Python (which I have done) only cmd line Version only
I think This would make a Good Project for newBE to Flower
and the final out come is to have a Submenu under the Pictures which would Run the Script.
This Code Has Change over time
mark 1: was for a Photo Frame (with a rename Option)
mark 2: only copy the right EXT (show i delete them)
mark 3: just copy files and don't rename them as to stop double ups
mark 4: find the USB card that was plug and scan all folders for images
sorry about the Code not the tidy est
Thanks
I hate Renaming Sorting files so I wrote the Below Script to put My Photos into a Folders Base on Year - Month of when the photo was taken
month name is wriiten by 1 jan (so it sorts it right)
Which read a MemStrick (base on its Drive Name ) and Copy them to Said path
Wife Said " Why do you have to exit XBMC to upload the Photos"
Good Point Dear
So I would Like HEAPS of Help in changing it to phyton
starting with Step1 on Loading Python (which I have done) only cmd line Version only
I think This would make a Good Project for newBE to Flower
and the final out come is to have a Submenu under the Pictures which would Run the Script.
This Code Has Change over time
mark 1: was for a Photo Frame (with a rename Option)
mark 2: only copy the right EXT (show i delete them)
mark 3: just copy files and don't rename them as to stop double ups
mark 4: find the USB card that was plug and scan all folders for images
sorry about the Code not the tidy est
Code:
'************************************************
'
' Copyright StePhan McKillen 2010
'
' This will copy all file and subfolder from Your Photo Location
' and rename then to a number as the photo frame does not care for File Name
' AS you could have File with the Same name in a Differance folder.
' You Need to Setup 5 thing
' 1. StartFrom where are the Photos
' 2. CopyTo Which Drive is the Stick in
' 3. EXT_OK What ext do you want to copy over.
' 4. LenEDI Just leave this at 7 if you have more than
' 5. Deletefile Delete file after move true/false
' 6. RENAMEFILE Rename the File true/false
' 7. BASENAME Letter at the Front DSC
'*************************************************
'
'*************************************************
' added the Get_Drive_letter so I did'nt have to change the Script
Const StickName = "12GB" 'if you want Don't want to use a Mem card by name make it = ""
Const StartFrom = "G:\DCIM\100PHOTO" '==== 1.
Const CopyTo = "F:\Photos" '==== 2.
Const EXT_OK = ",JPG,MPG,MP4," 'comma then EXT then Comma ie ,JPG,
Const LenEDI = 7 'Lenght of the Count String
Const Deletefile = False 'Delete files from the StartFrom delete file once copyed
Const RENAMEFILE = False 'Rename Files
Const BASENAME = "DSC" 'leading Letter
'*************************************************
'
'*************************************************
Dim FileCount
Call Start_Read
'*******************************************************************
'
'
'
'*******************************************************************
Sub Start_Read()
if StickName<>"" then
StartHere = Get_Drive_Letter(StickName)
else
StartHere = StartFrom
End If
if StickName<>"" And StartHere <> "" then
FileCount = 0
Dim FSO, Folder, SubFolders, Drive
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(StartHere)
FileCount = FileCount + 1
Call GenerateFolderInformation(Folder)
Set FSO = Nothing
MsgBox "Copy Finish copied " & FileCount & " Files " & vbnewline & vbnewline & "From " & StickName & " Files to " & CopyTo
Else
Msgbox("Can't Find the " & StickName & " Mem Card")
End if
End Sub
Sub GenerateFolderInformation(Folder)
Dim S
Dim SubFolders
Dim SubFolder
Dim Files
Dim File
Dim FileName
Dim FSO, EXT, TMPyear, MyMonth, TMPMonth, NewFileName
Dim MYYear
Dim ThisDateFile
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Files = Folder.Files
If Files.Count <> 0 Then
For Each File In Files
EXT = UCase(Right(File.Name, 3))
If InStr(UCase(EXT_OK), "," & EXT & ",") > 0 Then
ThisDateFile = Get_photo_date(folder,file.name)
MYYear = Year(ThisDateFile)
TMPyear = CopyTo & "\" & MYYear
If Not FolderExist(TMPyear) Then CreateFolder (TMPyear)
'MyMonth = MonthName(Month(File.DateLastModified), True)
My_Month = ThisDateFile
MyMonth = month(My_Month) & " " & MonthName(Month(My_Month),True)
TMPMonth = TMPyear & "\" & MyMonth
If Not FolderExist(TMPMonth) Then CreateFolder (TMPMonth)
if RENAMEFILE = true then
NewFileName = TMPMonth & "\" & BaseName & "" & EDITXT(FileCount, LenEDI, "0", True) & "." & EXT
Else
NewFileName = TMPMonth & "\" & File.name
End if
'Now Do the Work
FSO.CopyFile File, NewFileName
if Deletefile = true then FSO.Deletefile(file)
FileCount = FileCount + 1
End If
Next
End If
Set SubFolders = Folder.SubFolders
If SubFolders.Count <> 0 Then
For Each SubFolder In SubFolders
Call GenerateFolderInformation(SubFolder)
Next
End If
Set File = Nothing
Set SubFolder = Nothing
End Sub
Function EDITXT(ThisText, Leng, Txt, Leading)
If Len(ThisText) >= Leng Then
ThisText = Mid(ThisText, 1, Leng)
Else
End If
If Leading Then
EDITXT = String(Leng - Len(ThisText), Txt) & ThisText
Else
EDITXT = ThisText & String(Leng - Len(ThisText), Txt)
End If
If Len(EDITXT) <> Leng Then Stop
End Function
Function FolderExist(FolderName)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(FolderName) Then
FolderExist = True
Else
FolderExist = False
End If
End Function
Function CreateFolder(FolderName)
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.CreateFolder(FolderName)
Set f = Nothing
Set fs = Nothing
End Function
Function Get_photo_date(Path, FileName)
Dim objShell, objFolder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Path & "\")
sHeading = 25 ' Date taken
If (Not objFolder Is Nothing) Then
Dim objFolderItem
Set objFolderItem = objFolder.ParseName(FileName)
If (Not objFolderItem Is Nothing) Then
Dim objInfo
Get_photo_date = objFolder.GetDetailsOf(objFolderItem, sHeading)
End If
Set objFolderItem = Nothing
End If
Set objFolder = Nothing
Set objShell = Nothing
if trim(Get_photo_date) = "" then
Set FSOD = CreateObject("Scripting.FileSystemObject")
Set f = FSOD.GetFile(Path & "\" & Filename)
Get_photo_date = f.DateLastModified
set FSOD = nothing
Set F = nothing
End if
End Function
Function Get_Drive_Letter(CheckName)
strComputer = "."
Get_Drive_Letter = ""
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colComputer = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Drives = FSO.Drives
For Each DiskDrive In Drives
If DiskDrive.IsReady Then
If UCase(Trim(CheckName)) = UCase(Trim(DiskDrive.VolumeName)) Then
'MsgBox (DiskDrive.driveletter & ":" & DiskDrive.VolumeName)
Get_Drive_Letter = DiskDrive.driveletter & ":"
Exit For
Else
Get_Drive_Letter = ""
End If
End If
Next
End Function
Thanks