Need Help to Open File from assigned Folder and Check one condition , Delete and Save.

Hi Everyone,

I used Kill for file deleting, i just need code to remove "xxx" from file names.

any help please !

Thanks in advance.

Try something like this...

Sub checking()
    
    Dim wsHome As Worksheet
    Dim FilePath As String, FileName As String
    Dim NewFileName As String, FileExt As String
    Dim mrow As Long
    
    Set wsHome = ActiveWorkbook.Worksheets("Home")
    
    FilePath = wsHome.Range("C4").Value
    If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
    mrow = 5
    
    If Len(Dir$(FilePath, vbDirectory)) = 0 Then
        MsgBox FilePath, vbExclamation, "Cannot Locate Folder"
        Exit Sub
    Else
        Application.ScreenUpdating = False
        Do Until IsEmpty(wsHome.Range("F" & mrow))
            FileName = wsHome.Range("E" & mrow).Value
            If Len(Dir$(FilePath & FileName)) = 0 Then
                wsHome.Range("G" & mrow).Value = "File Not Found" 'File didn't exist
            Else
                Application.StatusBar = "Opening file: " & FilePath & FileName
                With Workbooks.Open(FileName:=FilePath & FileName)
                    If .ActiveSheet.Range("A3").Value = "" Then
                        .Close SaveChanges:=False
                        Kill FilePath & FileName    'Delete File
                        wsHome.Range("G" & mrow).Value = "File Deleted"
                    Else
                        .Close SaveChanges:=False
                        wsHome.Range("G" & mrow).Value = "File Saved"
                        FileExt = Mid(FileName, InStrRev(FileName, "."))
                        NewFileName = Left(FileName, Len(FileName) - Len(FileExt))
                        Do While Right(NewFileName, 1) = "x"
                            NewFileName = Left(NewFileName, Len(NewFileName) - 1)
                        Loop
                        'Rename File
                        Name FilePath & FileName As FilePath & NewFileName & FileExt
                        wsHome.Range("H" & mrow).Value = NewFileName & FileExt
                    End If
                End With
            End If
            mrow = mrow + 1
        Loop
        Application.ScreenUpdating = True
    End If
    Application.StatusBar = "Done"
    MsgBox "Assigned Work Successfully Done", vbInformation
    
End Sub