|
Free Resources from FMS |
|
|
|
|
"Thank you! Thank you! I just finished reading this document, which was part of a link in the recent Buzz newsletter. I have printed it for others to read, especially those skeptical on the powers of Access and its capabilities." - Darren D. |
|
|
|
|
Microsoft
Access Resource Center
How to Rename a File, Folder, or Directory from VBA, Visual Basic 6, Microsoft Office/Access/Excel
Provided by: FMS Development Team
Did you know there is a built-in statement in VB6/VBA/Office/Access/Excel that allows you to do this without using API calls and without referencing the File System?
From the VB6, VBA, Office/Access Help File
The Name statement moves the file to the new directory or folder and renames the file, if necessary. Here's the syntax:
Name OldPathName As NewPathName
Name can move a file across drives, but it can only rename an existing directory or folder when both OldPathName and NewPathName are located on the same drive. Name cannot create a new file, directory, or folder.
If OldPathName and NewPathName have different paths, and the same file name, the Name statement moves the file to the new location and leaves the file name unchanged.
Using Name, you can move a file from one directory or folder to another, but you cannot move a directory or folder.
Using Name on an open file produces an error. You must close an open file before renaming it. Name arguments cannot include multiple-character (*) and single-character (?) wildcards.
Note
Our example below only provides support for files or simple folder renaming (e.g. the path folder does not exist). Renaming a directory to a name that already exists is more complicated and may be included in a future tip.
Sample Code
Public Function TestNameStatement()
Dim fOK As Boolean
' Folders must exist for Source, but do not need to exist _
' for destination
fOK = RenameFileOrDir("C:\TestFolder\test.txt", _
"C:\TestFolder\test_NEWNAME.txt")
fOK = RenameFileOrDir("C:\TestFolder\test.txt", _
"D:\TestFolder\test_NEWNAME.txt")
' Folder must exist for source
fOK = RenameFileOrDir("C:\TestFolder",
_
"C:\TestFolder_NEWNAME")
' Folders only will fail across drives
fOK = RenameFileOrDir("C:\TestFolder", "D:\TestFolder")
End Function
Public Function RenameFileOrDir( _
ByVal strSource As String, _
ByVal strTarget As String, _
Optional fOverwriteTarget As Boolean = False) As Boolean
On Error GoTo PROC_ERR
Dim fRenameOK As Boolean
Dim fRemoveTarget As Boolean
Dim strFirstDrive As String
Dim strSecondDrive As String
Dim fOK As Boolean
If Not ((Len(strSource) = 0) Or _
(Len(strTarget) = 0) Or _
(Not (FileOrDirExists(strSource)))) Then
' Check if the target exists
If FileOrDirExists(strTarget) Then
If fOverwriteTarget Then
fRemoveTarget = True
Else
If vbYes = MsgBox("Do you wish to overwrite the " & _
"target file?", vbExclamation + vbYesNo, _
"Overwrite confirmation") Then
fRemoveTarget = True
End If
End If
If fRemoveTarget Then
' Check that it's not a directory
If ((GetAttr(strTarget) And vbDirectory)) <>
_
vbDirectory Then
Kill strTarget
fRenameOK = True
Else
MsgBox "Cannot overwrite a directory", vbOKOnly, _
"Cannot perform operation"
'FUTURE CODE FOR DIRECTORIES
End If
End If
Else
' The target does not exist
' Check if source is a directory
If ((GetAttr(strSource) And vbDirectory) = _
vbDirectory) Then
' Source is a directory, see if drives are the same
strFirstDrive = Left(strSource, InStr(strSource, ":\"))
strSecondDrive = Left(strTarget, InStr(strTarget, ":\"))
If strFirstDrive = strSecondDrive Then
fRenameOK = True
Else
MsgBox "Cannot rename directories across drives", _
vbOKOnly, "Cannot perform operation"
'FUTURE CODE FOR DIRECTORIES ON DIFFERENT DRIVES
End If
Else
'It's a file, ok to proceed
fRenameOK = True
End If
End If
If fRenameOK Then
Name strSource As strTarget
fOK = True
End If
End If
RenameFileOrDir = fOK
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"RenameFileOrDir"
Resume PROC_EXIT
End Function
Public Function FileOrDirExists(strDest As
String) As Boolean
Dim intLen As Integer
Dim fReturn As Boolean
fReturn = False
If strDest <> vbNullString Then
On Error Resume Next
intLen = Len(Dir$(strDest, vbDirectory + vbNormal))
On Error GoTo PROC_ERR
fReturn = (Not Err And intLen > 0)
End If
PROC_EXIT:
FileOrDirExists= fReturn
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"FileOrDirExists"
Resume PROC_EXIT
End Function
