Your question, your audience. Choose who sees your identity—and your question—with question security.
Option Explicit
Option Base 0
Sub CopyAndRename()
' modify path as required
Const PathName As String = "C:\Users\abcuser\AppData\Local\App01"
Dim SelFiles() As String
Dim NewFn As String ' Fn = file name
Dim OldFn As String
If GetSelectedFiles(PathName, SelFiles) Then
NewFn = NewFileName(SelFiles(0), OldFn)
If Len(NewFn) Then
FileCopy SelFiles(0), NewFn
Name SelFiles(0) As OldFn
Else
MsgBox "The selected file has no exension.", _
vbCritical, "Invalid file name"
End If
End If
End Sub
Private Function GetSelectedFiles(Pn As String, _
SelFiles() As String) _
As Boolean
' 0086 V 1.0
Dim FoD As FileDialog ' File Open Dialog
Dim SelItem As Variant ' Selected Item
Dim i As Long ' Index for SelFiles
Set FoD = Application.FileDialog(msoFileDialogFilePicker)
With FoD
.Title = "Choose the file to copy"
.ButtonName = "Create Copy"
.Filters.Clear
.Filters.Add "XML files", "*.xml", 1
.InitialFileName = WithSeparator(Pn)
.AllowMultiSelect = False
If .Show Then
For Each SelItem In .SelectedItems
ReDim Preserve SelFiles(i)
SelFiles(i) = SelItem
i = i + 1
Next SelItem
GetSelectedFiles = True
End If
End With
Set FoD = Nothing
End Function
Private Function NewFileName(Ffn As String, _
OldFn As String) As String
Dim Sp() As String
Dim Fn As String ' File name (original)
Dim Ext As String
Sp = Split(Ffn, ".")
If UBound(Sp) Then
Ext = Sp(UBound(Sp))
Fn = Left(Ffn, Len(Ffn) - (Len(Ext) + 1))
OldFn = Fn & "Old." & Ext
NewFileName = Fn & "New." & Ext
End If
End Function
Private Function WithSeparator(ByVal PathName As String, _
Optional ByVal RemoveExisting As Boolean) _
As String
Do While Right(PathName, 1) = Application.PathSeparator
PathName = Left(PathName, Len(PathName) - 1)
Loop
WithSeparator = PathName & IIf(RemoveExisting, "", _
Application.PathSeparator)
End Function
The program will allow you to select a file, starting in the directory you mentioned (you can choose another default by assigning another string to the constant 'PathName' at the top of the code). When you press the "Create Copy" button in the file_open dialog box the selected file will be renamed as [file]New.[Ext] and a copy will be created as [file]Old.[Ext]Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
Regards,
Rob.
Open in new window