文件访问错误VBA重命名文件夹

时间:2018-01-12 17:34:40

标签: vba permissions

我可以从Windows资源管理器重命名文件和文件夹。 当我尝试以实用方式重命名文件夹时,它会出现文件访问错误:

            Name ActiveCell.Value As ActiveCell.Value + " MOVED"
  

运行时错误' 75':路径/文件访问错误

ActiveCell.Value的位置是: "S:\Allied MTRS\Not Scanned\FITTINGS AND FLANGES\TI3 AR 214"

这是一个难题。 以下是其他一些有助于更好地理解问题的信息。

"名称"在代码中失效的陈述。

我的程序崩溃后,如果我在我编写的单独例程中尝试相同的Name语句,它仍然无法正常工作:

Sub tryitz()

    Name "S:\Allied MTRS\Not Scanned\FITTINGS AND FLANGES\TI3 AR 214" As "S:\Allied MTRS\Not Scanned\FITTINGS AND FLANGES\TI3 AR 214 MOVED"

End Sub

有趣的是,当我关闭excel并再次重新打开excel时,tryitz()例程可以正常工作。

这让我相信excel中的某些东西正在坚持下去 我从未真正打开过档案。 我刚做了一堆文件移动。 但是,尽管如此,我试图在移动之前做关闭,看看是否会起作用。

Close
Name ActiveCell.Value As ActiveCell.Value + " MOVED"

它不起作用。

这是我的完整例程(您可能不需要阅读所有这些例程,但我确实包含了主代码(ApplyPrefix),后跟GetFileList例程,该例程也由主模式调用:

Option Explicit

Const CalcErrorText = "Can't Calculate!"
Const AppliedText = ""




    Sub ApplyPrefix()


        'On Error GoTo CatchAll
        'On Error GoTo 0

        Dim r As Range
        Set r = ActiveSheet.Range("A5")
        r.Activate

        Dim Target As String
        Target = ActiveSheet.Range("A2").Value

        Do While ActiveCell.Value <> ""

            If ActiveCell.Offset(0, 1).Value = CalcErrorText Or ActiveCell.Offset(0, 1).Value = AppliedText Then
                'skip it.
            Else

                Dim p As String
                p = ActiveCell.Value

                Dim t As String
                t = Left(p, 2)


                If Right(t, 1) = ":" Then   'xxxx
                    ChDrive t
                    ChDir p


                    Dim ndx As Integer
                    Dim FileList3 As Variant
                    FileList3 = GetFileList(p + "\*.pdf")
                    If IsArray(FileList3) Then
                        For ndx = LBound(FileList3) To UBound(FileList3)
                            Call DeleteIfBrokenFile(ActiveCell.Value, FileList3(ndx))
                        Next
                    End If

                    Dim FileList As Variant
                    FileList = GetFileList(p + "\*.pdf")



                    If IsArray(FileList) Then
                        For ndx = LBound(FileList) To UBound(FileList)


                            Dim ApplyPrefix As String
                            ApplyPrefix = ActiveCell.Offset(0, 1).Value

                            Dim s As String
                            s = FileList(ndx)



                            Dim MoveFrom As String
                            Dim MoveTo As String
                            MoveFrom = ActiveCell.Value + "\" + FileList(ndx)



                            If GetFirstWord(s, " ") = ApplyPrefix Then  'zzzz
                                'File is already Renamed

                                MoveTo = Target + "\" + RemoveDotsInFileName(FileList(ndx))

                            Else


                                MoveTo = Target + "\" + ApplyPrefix + " " + RemoveDotsInFileName(FileList(ndx))


                                If Len(MoveTo) > 240 Then
                                'File Name too big.  Assign Random File Name
                                    Dim ii As Integer

                                    ii = Int((30000 * Rnd) + 1)
                                    MoveTo = Target + "\" + ApplyPrefix + " " + CStr(ii) + Format(Now(), "ms") + ".pdf"

                                    Do While FileThere(MoveTo)
                                        ii = Int((30000 * Rnd) + 1)
                                        MoveTo = Target + "\" + ApplyPrefix + " " + CStr(ii) + Format(Now(), "ms") + ".pdf"
                                    Loop


                                End If


                            End If      'zzzz

                            Name MoveFrom As MoveTo

                        Next



                    Else
                        'no files; you're done.

                    End If



                    'Weather you have files or not, delete the folder as long as there is no pdf inside...
                    'Processed all files, now delete folder...
                    Dim FileList2 As Variant
                    FileList2 = GetFileList(ActiveCell.Value + "\*.pdf")        'extra safety...
                    If IsArray(FileList2) Then
                        'If there are pdf's do not delete
                    Else
                        'Call RecursiveFolderDelete(ActiveCell.Value)
                        Close

                        'Name ActiveCell.Value As ActiveCell.Value + " MOVED"

                    End If

                    ActiveCell.Offset(0, 1).Value = AppliedText


                Else

                    ActiveCell.Offset(0, 1).Value = CalcErrorText
                    ActiveCell.Offset(0, 1).Font.ColorIndex = 3

                End If

            End If

            ActiveCell.Offset(1, 0).Select
        Loop

        MsgBox "Completed File Move..."
        End

    CatchAll:
        MsgBox "Something went wrong.  Notify Administrator.  The last attempt to move file was as follows..."
        MsgBox "From File...:  " + MoveFrom
        MsgBox "To File...:  " + MoveTo

        End

    End Sub




Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String

    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound

'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
NoFilesFound:
    GetFileList = False
    On Error GoTo 0
End Function

0 个答案:

没有答案