我可以从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