Move file whilst add datestamp to filename 1

[hsingh1981]

Hi all,

I managed to move all files with the extension *.mdi What i would like to do is to add a datestamp at the end of each file whilst i'm moving the files over. Can this be done? Preferably before "." extension name but after the filename

Sub MoveFilesFolder2Folder()
On Error GoTo EH
Dim FSO
Dim dateStamp As Date

dateStamp = Format(Date, "_yyyy_mm_dd")


Set FSO = CreateObject("Scripting.FileSystemObject")
'On Error Resume Next
If Not FSO.FolderExists(sfol) Then
    MsgBox sfol & " is not a valid folder/path.", vbInformation, "Invalid Source"
    
ElseIf Not FSO.FolderExists(dfol) Then
    MsgBox dfol & " is not a valid folder/path.", vbInformation, "Invalid Destination"
    
Else
    FSO.MoveFile (sfol & "\*.mdi"), (dfol & dateStamp) ' Change "\*.*" to "\*.mdi" to move mdi Files only
    
End If


EH:
  If Err.Number = 58 Then     '<----- Special handling for File Exists
       
        MsgBox "File Exists"
  Else
        MsgBox "Error " & Err.Number & ": " & Err.Description   '<---- General error handling
  End If
If Err.Number = 53 Then MsgBox "File not found"

End Sub

 

[hsingh1981]

Just sussed it out. I think am getting quite good at this.
I'm leaving a solution for those who come with a similar problem.

Working Solution

Sub MoveFilesFolder2Folder(Directory As String)
On Error GoTo EH
Dim cFso

Set cFso = CreateObject("Scripting.FileSystemObject")

Dim newname As String



dateStamp = Format(Date, "_yyyy_mm_dd")


'Make sure the path is in the right format
If Right(Directory, 1) <> "\" Then
  MyProperPath = Directory & "\"
Else
  MyProperPath = Directory
End If

'Find the first file in the directory
MyFileName = Dir(MyProperPath & "*.mdi*")

Do While MyFileName <> ""

newfilename = (UCase(Mid(MyFileName, 1, InStrRev(MyFileName, ".") - 1))) & dateStamp & ".MDI"

cFso.MoveFile (sfol & "\" & MyFileName), (dfol & "\" & newfilename)

Debug.Print newfilename

MyFileName = Dir

Loop


EH:
  If Err.Number = 58 Then     '<----- Special handling for File Exists
       
        MsgBox "File Exists"
  Else
        MsgBox "Error " & Err.Number & ": " & Err.Description   '<---- General error handling
  End If
If Err.Number = 53 Then MsgBox "File not found"



End Sub

 

[MikeC14081972]

Can i suggest the following changes

Sub MoveFilesFolder2Folder(Directory As String)
On Error GoTo EH
YOUR CODE

[COLOR=red] Exit Sub [/color]
EH:
  If Err.Number = 58 Then     '<----- Special handling for File Exists
       
        MsgBox "File Exists"
  Else
        MsgBox "Error " & Err.Number & ": " & Err.Description   '<---- General error handling
  End If
If Err.Number = 53 Then MsgBox "File not found"

[COLOR=red] Exit Sub [/color]

End Sub

This will stop your code going through the error handler each time the code is run even if there isn't an error.

Hope That Helps.

 

[hsingh1981]

Thanks mike, any good suggestions are welcome.

 

[MikeC14081972]

Glad to help