【已解决】BAT怎样实现多个文件夹下有多种格式的图片重命名？

001011 · 发表于 2013-8-20 09:40:04

路径下的多个文件夹下有多种格式（.tig .jpg .pdf）的图片重命名
本身的文件名很乱，文件名的位数也不一致（如下图）
按图片现有顺序批量命名成1开头的5位数的名字：10001 10002
就怕出现下面这种的现象，顺序都是乱的
0.jpg
000.jpg
001.jpg
0010.jpg
00100.jpg
00101.jpg
00102.jpg
00103.jpg
00104.jpg
00105.jpg
00106.jpg
00107.jpg
00108.jpg
00109.jpg
0011.jpg
00110.jpg
00111.jpg
00112.jpg
00113.jpg
00114.jpg
00115.jpg
00116.jpg
00117.jpg
00118.jpg
00119.jpg
0012.jpg
00120.jpg
00121.jpg
00122.jpg
00123.jpg
00124.jpg
谢谢

ADSL0125 · 发表于 2013-8-20 10:22:24

本帖最后由 ADSL0125 于 2013-8-20 10:27 编辑

"图片现有顺序"
是指文件在资源管理器中按文件名升序吗?

例如
这种是字符排序
000.jpg
0101.jpg
099.jpg
100.jpg       <--1比0大,所以在最后
=====================================

资源管理器中是编号(数字)排序
000.jpg
099.jpg
100.jpg
0101.jpg    <-- 0101认为是101,比100大,所以在最后
=====================================
你要哪一种?

001011 · 发表于 2013-8-20 12:41:22

本帖最后由 001011 于 2013-8-20 12:42 编辑

后面一种
资源管理器中是编号(数字)排序
000.jpg
099.jpg
100.jpg
0101.jpg    <-- 0101认为是101,比100大,所以在最后

001011 · 发表于 2013-8-20 12:45:56

回复 2# ADSL0125

我需要这种，感谢！
资源管理器中是编号(数字)排序
000.jpg
099.jpg
100.jpg
0101.jpg <-- 0101认为是101,比100大,所以在最后

ADSL0125 · 发表于 2013-8-20 14:05:18

本帖最后由 ADSL0125 于 2013-8-20 15:49 编辑

回复 4# 001011

更正一下,那个排序名称应该叫 字符逻辑排序,
有专用的API函数,StrCmpLogicalW,用于比较两个字符串

BAT做模拟的话,可能会的与资源管理器排序不同(因为你不知道微软是怎么排的)

估计写程序调用API来对文件排序再改名比较容易实现

terse · 发表于 2013-8-20 17:35:57

纯数字文件名也许BAT可试下加其他结合难度增加不少

001011 · 发表于 2013-8-20 19:03:51

回复 5# ADSL0125
那么复制啊能否帮忙写一下代码啊

001011 · 发表于 2013-8-20 22:21:36

可不可以先补位再命名呢  比如
000.jpg
099.jpg
100.jpg
0101.jpg
补位成
0000.jpg
0099.jpg
0100.jpg
0101.jpg

ADSL0125 · 发表于 2013-8-20 23:38:56

本帖最后由 ADSL0125 于 2013-8-21 00:56 编辑

回复 1# 001011

VBA调用API来排序,需要电脑上装有Excel 2003或以上

分选择文件夹和重命名两步,重命名前可以先看到准备改为的名字

Option Explicit
Declare Function StrCmpLogicalW Lib "shlwapi" (ByVal S1 As String, ByVal S2 As String) As Integer
'2.重命名
Public Sub Rename()
'获取行数
Dim L As Long
L = MainSheet.Range("D1").End(xlDown).Row - 2
If L < 0 Or Len(MainSheet.Range("D2").Value) = 0 Then Exit Sub '没有数据退出
'重命名
Dim F As Long, C As Long
On Error GoTo ErrRename
Call MainSheet.Range("E2:E50000").Clear
For F = 0 To L
If Len(MainSheet.Range("D2").Offset(F).Value) Then
C = F
MainSheet.Range("E2").Offset(F).Value = "OK"
Name MainSheet.Range("B2").Offset(F).Value As MainSheet.Range("D2").Offset(F).Value
End If
Next
GoTo EXT
ErrRename:
MainSheet.Range("E2").Offset(C).Value = "错误:" & Err.Description
Resume Next
EXT:
End Sub
'1.选择文件夹
Public Sub Start()
'获取选择路径
Dim OFD As FileDialog
Set OFD = Excel.Application.FileDialog(msoFileDialogFolderPicker)
Call OFD.Show
If OFD.SelectedItems.Count = 0 Then Exit Sub
Dim Path As String
Path = OFD.SelectedItems(1) & ""
'获取文件,并排序
Dim Files() As String
On Error GoTo ErrGetDirFiles
Files = GetDirFiles(Path)
On Error GoTo 0
Files = FilesOrderByLogical(Files)
'输出
Dim F As Long, L As Long
Call MainSheet.Range("A2:E50000").Clear
L = UBound(Files)
For F = 0 To L
MainSheet.Range("A2").Offset(F).Value = F + 1
MainSheet.Range("B2").Offset(F).Value = Path & Files(F)
MainSheet.Range("C2").Offset(F).Value = GetExName(Files(F))
MainSheet.Range("D2").Offset(F).Value = Path & "1" & Right("000" & (F + 1), 4) & "." & GetExName(Files(F))
Next
GoTo EXT
ErrGetDirFiles:
Call MsgBox("获取文件夹中文件发生错误,文件夹中可能没有文件", vbOKOnly)
GoTo EXT
EXT:
End Sub
'取得文件名的扩展名
Public Function GetExName(ByVal S As String) As String
Dim I As Long
I = InStrRev(S, ".")
If I = -1 Then Exit Function
GetExName = Mid(S, I + 1)
End Function
'对数组中的字符串进行逻辑排序(升序)
Public Function FilesOrderByLogical(ByRef Files() As String) As String()
Dim F1 As Long, F2 As Long
Dim L As Long
Dim T As String
L = UBound(Files)
For F1 = 0 To L - 1
For F2 = F1 + 1 To L
If StrCmpLogicalW(StrConv(Files(F1), vbUnicode), StrConv(Files(F2), vbUnicode)) > 0 Then
T = Files(F1)
Files(F1) = Files(F2)
Files(F2) = T
End If
Next
Next
FilesOrderByLogical = Files
End Function
'取得文件夹中的文件,不包含子文件夹
Public Function GetDirFiles(ByVal Path As String) As String()
Dim Files() As String
Dim C As Long, MAXC As Long
Dim S As String
MAXC = 100
ReDim Files(MAXC - 1)
S = Dir(Path) '第一个文件
Do While (Len(S))
Files(C) = S
C = C + 1
If C > MAXC Then '超过数组范围,扩展数组
MAXC = MAXC * 2
ReDim Preserve Files(MAXC - 1)
End If
S = Dir
Loop
ReDim Preserve Files(C - 1)
GetDirFiles = Files
End Function

复制代码

001011 · 发表于 2013-8-20 23:52:50

回复 9# ADSL0125
非常感谢
经测试
获取文件夹不知道是否我操作问题不能获取文件总是提示为空
如果能正常获取文件夹的话能否像BAT那样一个文件夹下实现多个文件夹同时命名呢
再次感谢

ADSL0125 · 发表于 2013-8-20 23:54:28

本帖最后由 ADSL0125 于 2013-8-20 23:57 编辑

空就对了,EXCEL选择"文件夹"的窗口就是这样
,直接按确定会列出你选择的文件夹下的所有文件

另外,同时对多个文件夹进行操作的话
那么文件序号是跨文件夹累计的,还是每个文件夹重新编号?

001011 · 发表于 2013-8-21 00:20:30

回复 11# ADSL0125

命名有文件但是提示为空啊
多个文件夹下的图片需要独立编号

ADSL0125 · 发表于 2013-8-21 01:00:26

回复 12# 001011

Dir 检索文件时,忽略的只读文件和隐藏文件,修改增加对应的标志

如果还不行的话,试试采用FSO获取文件的方法

001011 · 发表于 2013-8-21 09:42:38

非常感谢目的达到了就是不能批量有点遗憾呵呵

chpiter · 发表于 2014-10-28 16:35:13

回复 001011

Dir 检索文件时,忽略的只读文件和隐藏文件,修改增加对应的标志

如果还不行的 ...
ADSL0125 发表于 2013-8-21 01:00

漂亮
64位 Declare PtrSafe Function StrCmpLogicalW Lib "shlwapi" (ByVal S1 As String, ByVal S2 As String) As Integer

重命名这个操作坑人，。。。。一不小心手贱点了

		自动登录	找回密码
密码			注册

[新手上路]批处理新手入门导读	[视频教程]批处理基础视频教程	[视频教程]VBS基础视频教程	[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动	[批处理精品]CMD命令50条不能说的秘密	[在线下载]第三方命令行工具	[在线帮助]VBScript / JScript 在线参考

[文件操作] 【已解决】BAT怎样实现多个文件夹下有多种格式的图片重命名？

评分

评分