首页 > 解决方案 > 使用 Excel VBA 重命名位于服务器中的文件夹/文件

问题描述

我正在编写一个宏,其主要功能是重命名特定服务器位置(主文件夹)中的文件夹。此主文件夹上的所有文件都有前 3 个字符作为数字,按顺序排列。由于我经常更改它们,我想要一个能够从一个项目重命名文件夹的宏(这个项目将是文件夹名称的前 3 个字符)

我遇到的问题是,由于文件位于服务器中,我无法真正更改名称,看起来我只能更改出现在用户面前的名称,但不能更改“真实”/名字。

也许有几张图片可能会有所帮助: 在此处输入图像描述

我们使用的代码如下:

Private Sub PrintFolders()

    Dim objFSO As Object
    Dim objFSO_2 As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim fileExcel As Object
    Dim xpto As Object
    Dim objSubSubFile_Excel As Object
    Dim auxStringName As String, auxStringPath As String
    Dim i As Integer

    Application.StatusBar = ""

    'Get Folder Path
    auxStringPath = Range("C2").Text
    If auxStringPath = "" Then
        Err = 19
        GoTo handleCancel
    End If
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder(auxStringPath)
    i = 0
    'Get intBegin
    intBegin = CInt(Range("C3").Value)

    'loops through each folder in the directory and prints their names and path
    On Error GoTo handleCancel
    Application.EnableCancelKey = xlErrorHandler
    'MsgBox "This may take a long time: press ESC to cancel"

    For Each objSubFolder In objFolder.subfolders
        Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name

        If CInt(Left(objSubFolder.Name, 3)) >= intBegin Then

            If intBegin < 10 Then
                auxStringName = "00" & CStr(intBegin + i) & Mid(objSubFolder.Name, 4)
            ElseIf intBegin < 100 Then
                auxStringName = "0" & CStr(intBegin + i) & Mid(objSubFolder.Name, 4)
            Else
                auxStringName = CStr(intBegin + i) & Mid(objSubFolder.Name, 4)
            End If

            For Each fileExcel In objSubFolder.Files
                If Right(fileExcel.Name, 4) = "xlsx" Or Right(fileExcel.Name, 4) = "xlsm" Then
                    Name auxStringPath & "\" & objSubFolder.Name & "\" & fileExcel.Name As auxStringPath & "\" & objSubFolder.Name & "\" & Left(auxStringName, 3) & Mid(fileExcel.Name, 4)
                End If
            Next fileExcel

            Name auxStringPath & "\" & objSubFolder.Name As auxStringPath & "\" & auxStringName

            i = i + 1

        End If

    Next objSubFolder

handleCancel:

    If Err = 18 Then
        MsgBox "You cancelled"
    ElseIf Err = 19 Then
        MsgBox "Missing Path"
    End If

    Set objFSO = Nothing
    Set objFolder = Nothing

End Sub

有人可以帮忙吗?anzone 有没有类似的问题?

标签: excelvba

解决方案


推荐阅读