Chào Anh Chị!!! Em có vấn đề cần giúp đổi tên file sau khi move vào subfolder!!! (1 người xem)

[nguyenanhdung8111982]

em có đoạn code như dưới: Sau khi move hình ảnh đến folder
ví dụ: list hình như dưới sẽ move vô folder 20200921_22_014_TPThuanAn_BD_GS103997

Sau khi move vô folder em muốn rename bỏ hết chuỗi trước dấu "_". Chỉ giữ lại tên từ "GS" trở đi. Như hình dưới

Public Sub Move_Files()

    Dim sourceFolder As String, fileName As String
    Dim destinationFolder As String, foundDestinationFolder As String
    Dim missingFolders As String
    On Error Resume Next
    'sourceFolder = "D:\Vidu\"
    sourceFolder = Application.InputBox("Nhap duong dan: ")
    If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
    
    'Loop through *.xls files in source folder
    
    missingFolders = ""
    fileName = Dir(sourceFolder & "*.jpg")
    While fileName <> vbNullString
        If Right(fileName, 4) = ".jpg" Then
            destinationFolder = Left(fileName, InStrRev(fileName, "GS") + 7)
            'destinationFolder = Left(fileName, Len(fileName) - 7)
            foundDestinationFolder = Find_Subfolder(sourceFolder, destinationFolder)
            If foundDestinationFolder <> "" Then
                Name sourceFolder & fileName As foundDestinationFolder & fileName
            Else
                missingFolders = missingFolders & vbCrLf & destinationFolder
            End If
        End If
        fileName = Dir
    Wend
    
    If missingFolders = "" Then
        MsgBox "Tat Ca Folder exist.  All files moved to their respective destination folder"
    Else
         MsgBox "Folder Khong Ton Tai" & vbCrLf & _
                missingFolders
    End If

End Sub



Private Function Find_Subfolder(folderPath As String, subfolderName As String) As String

    Static FSO As Object
    Dim FSfolder As Object, FSsubfolder As Object
    
    'Traverse subfolders from a folder path and return when matching folder name found
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set FSfolder = FSO.GetFolder(folderPath)
     
    Find_Subfolder = ""
    For Each FSsubfolder In FSfolder.SubFolders
        If UCase(FSsubfolder.Name) = UCase(subfolderName) Then
            Find_Subfolder = FSsubfolder.path & "\"
        Else
            Find_Subfolder = Find_Subfolder(FSsubfolder.path, subfolderName)
        End If
        If Find_Subfolder <> "" Then Exit For
    Next
    
End Function

Trân trọng cám ơn!!!