Oscar Sun

                  Sub 檔案重新命名()
Dim fs, fc, fl, f ', OldName As String, NewName As String
'p = ""InputBox("請輸入路徑", , p)
Const p = "C:\Documents and Settings\xxx\My Documents\My Pictures\reName" '"請輸入路徑"
'If Dir(p) = "" Then MsgBox "請檢查路徑": Exit Sub
Const o = "!!" '被取代字串
Const n = "@@@" '取代字串

Const 卷 = "14"
Const 新檔起始號 = 177

'Const 原檔起始號 = 1 '均先批次重新命名為１開始
Const 副檔名 = ".jpg"
If p = "" Then Exit Sub


Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(p)
Set fc = f.Files
'原檔起始號 = CLng(Mid(fc.Item(1), 2))
For Each fl In fc
    原檔起始號 = CLng(Mid(Replace(fl.Name, 副檔名, ""), 2))
    Exit For
Next
For i = 0 To fc.Count - 1
    If (i + 1) Mod 2 = 0 Then
        fc(Format(i + 原檔起始號, "a000000" & 副檔名)).Name = Format(卷, "00000") & "_" & Format(Int(i / 2) + 新檔起始號, "000000" & "b" & 副檔名)
    Else
        fc(Format(i + 原檔起始號, "a000000" & 副檔名)).Name = Format(卷, "00000") & "_" & Format(Int(i / 2) + 新檔起始號, "000000" & "a" & 副檔名)
    End If
Next i
'For Each fl In fc
'    fl.Name = Replace(fl.Name, o, n)
'
'Next fl
End Sub