请选择 进入手机版 | 继续访问电脑版

工程检测论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

查看: 2012|回复: 2

[EXCEL学习] 一段批量修改文件名的小程序

[复制链接]
发表于 2012-3-29 10:04:27 | 显示全部楼层 |阅读模式

工程检测网微信订阅号

一分钟快速注册,轻松融入检测圈

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
一段批量修改文件名的小程序:
Dim filePath As Variant            '定义filepath为变量
Dim obj As Object                  '定义obj为变量对象
Dim fld, ff, gg                    '定义fld,ff,gg为变量
Sub getpath()
    Range("A2:C1000").ClearContents               '清空A2:C1000列
    On Error Resume Next
    Dim shell As Variant
    Set shell = CreateObject("Shell.Application")
    Set filePath = shell.BrowseForFolder(&O0, "选择文件夹", &H1 + &H10, "")   '获取文件夹路径地址
    Set shell = Nothing
  If filePath Is Nothing Then                 '检测是否获得有效路径,如取消直接跳出程序
       Exit Sub
    Else
       gg = filePath.Items.Item.path
  End If
    Set obj = CreateObject("Scripting.FileSystemObject")   '定义变量
    Set fld = obj.getfolder(gg)                            '获取路径
     For Each ff In fld.Files                   '遍历文件夹里文件
        m = m + 1
        Cells(m + 1, 1) = ff.Name
        Cells(m + 1, 2) = "-------"
        Cells(m + 1, 3) = ff.Name
      Next
End Sub
Sub renamefile()
     On Error Resume Next
     If [a2] = "" Then MsgBox "请点击第一步": Exit Sub
      For Each ff In fld.Files                 '遍历文件夹里的所有文件
        m = m + 1
       ff.Name = Cells(m + 1, 3)              '将实际文件名改成目录中C列的对应文件名
      Next
      MsgBox "改名已完成,请检查", vbOKOnly
End Sub

回复

使用道具 举报

发表于 2012-12-14 15:09:03 | 显示全部楼层
学习你的帖子。
发表于 2018-4-1 17:40:55 | 显示全部楼层
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

广播台
招聘信息台 我也要招聘

QQ|小黑屋|手机版|工程检测网检测论坛 ( 苏ICP备09082304号-7

GMT+8, 2018-12-16 04:58 , Processed in 0.184792 second(s), 20 queries , Apc On.

免费咨询电话:400-025-5580

快速回复 返回顶部 返回列表