使用VBA重命名不同驱动器上的文件

时间:2018-03-28 20:12:37

标签: vba excel-vba excel

我在工作表中有一个文件名列表。我想读一个名字,找到实际的文件,重命名并转到下一个名字。

第一部分,从工作表中检索名称并将其修改为新名称不是问题。问题是将新名称分配给文件。

“名称”功能不起作用,因为文件位于不同的驱动器上。我也尝试过Scripting.FileSystemObject。

代码运行但未进行任何更改。 这是我用过的代码......

Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set f = fso.GetFile(fOldName)
If Not Err = 53 Then 'File not found
  'Rename file
  f.Name = fNewName
End If

我是否犯了一个我没看到的代码错误?我应该使用/做其他事吗?

如今,查找有关VBA和/或VB6的信息非常少见。

顺便说一句。这适用于Excel 2016。

韩国社交协会

1 个答案:

答案 0 :(得分:0)

如果没有误解......

FSO ......无论如何都不好。它只是一个错误的API包装器,用左鸡爪写的。 有纯粹的VB&用于更复杂案例的API。

没有外部的库和&对象:

Public Sub sp_PrjFilMov()
Dim i As Byte
Dim sNam$, sExt$, sPthSrc$, sPthTgt$, sDir$

    sPthSrc = "V:\"
    sPthTgt = "R:\"

    sNam = "Empty_"
    sExt = ".dmy"   ' dummy

    For i = 1 To 5 ' create set of files for test
        Call sx_CrtFil(i, sPthSrc, sNam, sExt)
    Next

    sDir = Dir(sPthSrc & "*" & sExt, vbNormal) ' lookup for our files ..
    Do
        'Debug.Print sDir
        Select Case LenB(sDir)
            Case 0
                Exit Do         ' *** EXIT DO
            Case Else
                Call sx_MovFil(sPthSrc, sDir, sPthTgt) ' ..  & move them to another disk
                sDir = Dir
        End Select
    Loop
    Stop
End Sub

Private Sub sx_CrtFil(pNmb As Byte, pPth$, pNam$, pExt$)
Dim iFilNmb%
Dim sFilNam$
    sFilNam = pPth & pNam & CStr(pNmb) & pExt
    iFilNmb = FreeFile
    Open sFilNam For Output As #iFilNmb
    Close #iFilNmb
End Sub

Private Sub sx_MovFil(pPnmSrc$, pFnm$, pPthTgt$)
Dim sSrcPne$
    sSrcPne = pPnmSrc & pFnm
    'Debug.Print "Move " & sSrcPne & " --> " & pPthTgt
    Call FileCopy(sSrcPne, pPthTgt & pFnm)
    Call Kill(sSrcPne)
End Sub
'