デジカメのファイルを移動するvbs

デジカメの画像を、指定のフォルダの下に、日付形式のフォルダを作り、そこに連番で名前を変更して移動するスクリプトを作ってみた。
なんかあんまり汎用性がない気もするけど、まぁそれなりに使えるかなぁ。

Option Explicit
'*********************************************
' 必要な定数の設定
' srcFolderName ：デジカメの画像のフォルダのパスを指定
' dstFolderName ：デジカメの画像ファイルを移動するパスを指定
' intFig ：画像ファイルの連番を振る際の数字の桁数
'**********************************************
Const srcFolderName = "D:\DCIM\100MSDCF"
Const dstFolderName = "C:\temp"
Const intFig = 3
Dim objFS
Dim objSubFLD
Dim strFile
Dim intCount
Dim strNewPath
Dim chkFolder
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objSubFLD = objFS.GetFolder(srcFolderName)

intCount = 1
For each strFile in objSubFLD.Files
  strNewPath = makeNewFolderPath & "\" & ModifyDigit(intCount) & ".jpg"
  strFile.Move strNewPath
  intCount = intCount + 1
Next

Wscript.Echo "終了"

Function makeNewFolderPath()
  Dim arrDate
  Dim strFLDName
  Dim tmpFLDName

  arrDate = split(date(),"/")
  For each tmpFLDName in arrDate
    strFLDName = strFLDName & tmpFLDName
  next
  chkFolder = dstFolderName & "\" & strFLDName
  If objFS.FolderExists(chkFolder) = False Then
    objFS.CreateFolder chkFolder
  End If
  makeNewFolderPath = chkFolder
End Function

Function ModifyDigit(strFig)
  Dim strBuffer
  strBuffer = right(string(intFig,"0") & strFig, intFig)
  ModifyDigit = strBuffer
End Function