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?
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.
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.
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 MsgBox("Do you wish to overwrite the target file?", vbExclamation + vbYesNo, "Overwrite confirmation") = vbYes 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" 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" 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
For other VBA and VB6 Source Code, check out our Total Visual SourceBook code library with royalty-free code you can add to your applications.