Help edit code select folder not input path directory

[Nguyen Anh Dung]

help edit code when run use mouse select folder not input directory folder as below:
Const strSOURCE_DIR = "d:\Image_SoNha\"
Const strTARGET_DIR = "d:\Image_SoNha\"

Public Sub MoveImages()
 Const strSOURCE_DIR = "d:\Image_Goc\"
 Const strTARGET_DIR = "d:\Image_SoNha\"
  
Dim strSourcePath As String
  Dim strTargetPath As String
  Dim strSubfolder As String
  Dim strFilename As String
  Dim strMessage As String
  Dim strErrors As String
  Dim lngCounter As Long
                

  On Error GoTo ErrHandler
  strFilename = Dir(strSOURCE_DIR & "*.jpg")
    Do While strFilename <> ""
    strSourcePath = strSOURCE_DIR & strFilename
    strSubfolder = strTARGET_DIR & "20200914_13_" & Mid(strFilename, 2, 3) & "_GoVap_D_01" 'D: Duong, H: Hem, 01: Di,02 Ve: tu sua
    strTargetPath = strSubfolder & "\" & strFilename
    
  ' tao folder neu k ton tai
    On Error Resume Next
    MkDir strSubfolder
    If Err.Number <> 0 Then Err.Clear
  
  ' cat qua thu muc moi
    Name strSourcePath As strTargetPath
    
  ' If an error occurred, log it to error list
    If Err.Number <> 0 Then
      If strErrors <> "" Then strErrors = strErrors & ", "
      strErrors = strErrors & strFilename
    Else
      lngCounter = lngCounter + 1
    End If
    
  ' Move onto next jpg file
    On Error GoTo ErrHandler
    strFilename = Dir()
  Loop
  
' Notify user of results, including any errors
  strMessage = "Transfer of " & lngCounter & " files was completed."
  If strErrors <> "" Then
    strMessage = strMessage & vbCrLf & vbCrLf
    strMessage = strMessage & "These files were unsuccessful:"
    strMessage = strMessage & vbCrLf & strErrors
  End If
  MsgBox strMessage, vbInformation
  Exit Sub
  
ErrHandler:
  MsgBox Err.Description, vbExclamation
End Sub