Home File Access Error VBA Renaming Folder
Reply: 0

File Access Error VBA Renaming Folder

user6750
1#
user6750 Published in May 21, 2018, 9:17 am

I am able to rename files and folders from windows explorer. When I try to rename folder pragmatically, it gives file access error:

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

Run-time error '75': Path/File access error

Where ActiveCell.Value is: "S:\Allied MTRS\Not Scanned\FITTINGS AND FLANGES\TI3 AR 214"

This is a puzzle. Here is some other information to help understand the problem better.

The "Name" statement that fails lives inside of code.

After my program crashes, if I try the same Name statement in a separate routine that I code up, it still doesn't work:

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

Interestingly enough, through, when I close the excel and reopen the excel again, the tryitz() routine works without error.

That lead me to believe that something in excel is holding on.
I never really did a file open. I just did a bunch of file moves. But nevertheless, I tried to do Close before the Move, to see if that would work.

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

It did not work.

Here is my complete routine (you may not need to read all of it, but I did include the main code (ApplyPrefix) followed by the GetFileList routine, which is also invoked by the main mode:

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
You need to login account before you can post.

About| Privacy statement| Terms of Service| Advertising| Contact us| Help| Sitemap|
Processed in 0.305907 second(s) , Gzip On .

© 2016 Powered by mzan.com design MATCHINFO