達人養成塾 小川です。
今日、お昼に、iPhoneをPCに差して同期を取ったら、ちょっとした事件。
同期先たるwindowsのフォルダでに写真ファイルがコピーされたとき、すでにそこに同じファイルかある場合はスキップしてくれればいいものを。
「IMG_1225.jpg があれば、 IMG_1225-1.jpg を作る」
みたいな感じで、別名のファイルが作られてしまいました。
実は、かつても何度か同じような問題が起こってはいたのですが。
そこで、不要な重複ファイルは自動削除する、というツールを自作しました。
今日は、それをご紹介。
‘Microsoft Scripting Runtime への参照設定をしてください
Sub mydel()
Debug.Print “start”
Dim c As Integer
c = CInt(InputBox(“set max num”))
myMove “.jpg”, c
myMove “.png”, c
Debug.Print “end”
End Sub
Sub myMove(ext As String, mx As Integer)
Dim fs As New Scripting.FileSystemObject
Dim fl(1) As Scripting.File
Dim fBase As String
Dim fname(2) As String
Dim s As String
Dim c As Long
Dim suf As Long
For c = 1 To mx
s = String(4 – Len(CStr(c)), “0”) & c
fBase = ThisWorkbook.path & “\IMG_” & s
fname(0) = fBase & ext
suf = 1
fname(1) = fBase & “-” & suf & ext
Do While fs.FileExists(filespec:=fname(1))
Set fl(0) = fs.GetFile(fname(0))
Set fl(1) = fs.GetFile(fname(1))
If fl(0).DateLastModified = fl(1).DateLastModified And fl(0).Size = fl(1).Size Then
fname(2) = ThisWorkbook.path & “\del\IMG_” & s & “-” & suf & ext
Debug.Print “exists” & vbTab & fname(2)
fs.MoveFile Source:=fname(1), Destination:=fname(2)
End If
suf = suf + 1
fname(1) = fBase & “-” & suf & ext
Loop
Next
For c = LBound(fl) To UBound(fl)
Set fl(c) = Nothing
Next
Set fs = Nothing
End Sub
明日からは、この内容とか、ここに至る経緯について、ちょこちょこ書いていこうと思います。
