excel VBA根据excel列值拷贝文件并修改文件名

最新推荐文章于 2024-08-10 14:59:16 发布

zky1347888

最新推荐文章于 2024-08-10 14:59:16 发布

阅读量3.1k

点赞数

分类专栏： office与宏VBA 文章标签： excel vba 宏 excel宏 excel编程

本文链接：https://blog.csdn.net/tutuboke/article/details/40620871

版权

office与宏VBA 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

excel 宏不会打开查一下百度，直接贴代码

excel 的 A列放得是现在的文件名字(可以写程序从文件夹中读到Excel中)，C列放得是要修改之后的文件名，D列会生成操作是否成功的标示。

宏的主要代码

Sub fsg()
    Dim MyArray1() As String
    Dim MyArray2() As String
    Dim iNum As Integer
    '获取当前列长度
    iNum = ActiveSheet.[A65536].End(xlUp).Row
    MsgBox iNum
    ReDim Preserve MyArray1(iNum) As String
    ReDim Preserve MyArray2(iNum) As String
    For i = 1 To iNum
       '将A列的 Ai值赋值给数组
        MyArray1(i - 1) = ActiveSheet.Range("A" & i).Value
        MyArray2(i - 1) = ActiveSheet.Range("C" & i).Value
    Next i
    'MsgBox MyArray1(11)
    'MsgBox MyArray2(11)
    Dim copyPath1 As String
    Dim copyPath2 As String
    copyPath1 = "C:\Users\hqy\Desktop\large\"
    copyPath2 = "C:\Users\hqy\Desktop\large1\"
    Dim name1 As String
    Dim name2 As String
    Dim changeName As String
    '声明检查文件是否存在
    Set fso = CreateObject("Scripting.Filesystemobject")
    For i = 1 To iNum
       '链接字符串
        name1 = copyPath1 & MyArray2(i - 1) & ".png"
        name2 = copyPath2 & MyArray2(i - 1) & ".png"
        changeName = copyPath2 & MyArray1(i - 1) & ".png"
        '检查文件是否存在
        If fso.FileExists(name1) Then
           '文件拷贝 从什么目录到什么目录
            FileCopy name1, name2
            '修改文件名称
            Name name2 As changeName
        Else
            '文件不存在 修改 excel标示
            ActiveSheet.Range("D" & i).Value = 0
        End If
    Next i
End Sub