FileCopy利用dir的结果

assizx

请教大家：
　　我想用下列vba实现“查找当前文件夹中的.xlsx文件，并复制为test.xlsx”，但没有成功。故请大家帮助查找失败原因
Sub main()
    flnm = Dir(ThisWorkbook.Path & "\*.xlsx")
    FileCopy flnm, ThisWorkbook.Path & "\test.xlsx"
End Sub

qflwork

Sub main()
    flnm = Dir(ThisWorkbook.Path & "\*.xlsx")
    While flnm <> ""
    i = i + 1
    FileCopy ThisWorkbook.Path & "\" & flnm, ThisWorkbook.Path & "\test" & i & ".xlsx"
    flnm = Dir
    Wend
End Sub
只能运行一次.

dir 一次只能一个文件。
多个文件得用循环。

小花鹿

FileCopy ThisWorkbook.Path & "\" & flnm, ThisWorkbook.Path & "\test.xlsx"

小花鹿

dir返回的只是文件名，不包含路径，而filecopy需要路径

笨鸟飞不高

大哥 ，多方面求助啊

assizx

笨鸟飞不高 发表于 2023-6-28 14:40
大哥 ，多方面求助啊

谢谢！还是你的答案比较周详。

assizx

笨鸟飞不高 发表于 2023-6-28 14:40
大哥 ，多方面求助啊

还是“笨鸟飞不高”老师的答案比较全面和及时！！！
Sub CopyAndRenameFile()
    Dim filePath As String
    Dim newFileName As String
    Dim currentFileName As String
   
    ' 获取当前文件夹路径
    filePath = ThisWorkbook.Path & "\"
   
    ' 获取当前文件名
    currentFileName = ThisWorkbook.Name
   
    ' 构建新文件名
    newFileName = "test.xlsx"
   
    fname = Dir(ThisWorkbook.Path & "\*.xls*")
    Do While fname <> ""
        If fname <> currentFileName Then
            ' 复制并重命名文件
            FileCopy filePath & fname, filePath & newFileName
            
            ' 提示复制成功
            MsgBox "文件复制成功，已重命名为 'test.xlsx'"
            Exit Do
        End If
        fname = Dir
    Loop
   
End Sub

'请注意，此代码将在当前运行的Excel文件所在的文件夹中查找.xlsx文件，并复制并重命名为 "test.xlsx"。
'如果当前文件夹中存在多个.xlsx文件，它将复制并重命名第一个遇到的文件。