'Author: Nguyen Duy Tuan - http://bluesofts.net
'FbGroup: https://www.facebook.com/groups/hocexcel/
Option Explicit 
#If VBA7 Then 
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr 
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 
#Else 
Private Declare Function GetDesktopWindow Lib "user32" () As Long 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 
#End If 
Private Sub Label5_Click() 
   ShellExecute GetDesktopWindow, "OPEN", "https://www.facebook.com/groups/hocexcel/", "", "", 1 
End Sub 
Private Sub UserForm_Initialize() 
   Frame1.Caption = ThisWorkbook.Sheets("CONTENTS").Range("A1").Value 
   'Store path
   txtSrcPath.Text = ThisWorkbook.Sheets("CONTENTS").Range("H2").Value 
   txtDestPath.Text = ThisWorkbook.Sheets("CONTENTS").Range("H3").Value 
End Sub 
Private Sub cmdGetSrcPath_Click() 
   Dim sPath As String 
   If GetFolder(sPath, "Select a source folder") Then 
      txtSrcPath.Text = sPath 
   End If 
End Sub 
Private Sub cmdGetDestPath_Click() 
   Dim sPath As String 
   If GetFolder(sPath, "Select a destination folder") Then 
      txtDestPath.Text = sPath 
   End If 
End Sub 
Private Sub cmdClose_Click() 
   Unload Me 
End Sub 
Private Sub cmdRename_Click() 
   Dim objFolder As Folder, objFile As File 
   Dim sFileName As String, nInc As Long, cFile As Long 
   Dim fso As New FileSystemObject 
   On Error GoTo lbEndSub 
   'Check data input
   If Len(Trim(txtSrcPath)) = "" Or Not fso.FolderExists(txtSrcPath.Text) Then 
      MsgBox "Thu muc nguon phai ton tai.", vbCritical 
      txtSrcPath.SetFocus 
      Exit Sub 
   End If 
   If Len(Trim(txtDestPath)) = "" Or Not fso.FolderExists(txtDestPath.Text) Then 
      MsgBox "Thu muc dich phai ton tai.", vbCritical 
      txtDestPath.SetFocus 
      Exit Sub 
   End If 
   If Not IsNumeric(txtSTART.Value) Then 
      MsgBox "START phai la gia tri so (Number).", vbCritical 
      txtSTART.SetFocus 
      Exit Sub 
   End If 
   If Not IsNumeric(txtSTART.Value) Then 
      MsgBox "START phai la gia tri so (Number).", vbCritical 
      txtSTART.SetFocus 
      Exit Sub 
   End If 
   If Not IsNumeric(txtSTEP.Value) Then 
      MsgBox "STEP phai la gia tri so (Number).", vbCritical 
      txtSTEP.SetFocus 
      Exit Sub 
   End If 
   cFile = 0 
   nInc = Val(txtSTART.Value) 
   Set objFolder = fso.GetFolder(txtSrcPath.Text) 
   For Each objFile In objFolder.Files 
      sFileName = GetFileName(objFile.Name) 
      sFileName = CreateFileName(nInc, sFileName) 
      'Dest File = Path + "\" + FileName + "." + Ext
      sFileName = txtDestPath.Text + Application.PathSeparator & sFileName & "." & GetFileExt(objFile.Name) 
      objFile.Copy sFileName, False 
      nInc = nInc + Val(txtSTEP.Value) 
      cFile = cFile + 1 
      'objFile.Move sFileName
   Next 
   ThisWorkbook.Sheets("CONTENTS").Range("H2").Value = txtSrcPath.Text 
   ThisWorkbook.Sheets("CONTENTS").Range("H3").Value = txtDestPath.Text 
   ShellExecute GetDesktopWindow, "OPEN", txtDestPath.Text, "", "", 1 
   MsgBox "Chuong trinh doi ten duoc " & cFile & " tap tin.", vbInformation 
lbEndSub: 
   If Err <> 0 Then 
      MsgBox Err.Description, vbCritical, "THONG BAO LOI" 
   End If 
   Set fso = Nothing 
   Set objFolder = Nothing 
End Sub 
'Ban co the tuy bien ham nay de nhan ten file theo y
Function CreateFileName(lIndex As Long, ByVal sOriginalFileName As String) As String 
   If optFileStep.Value Then 
      If IsNumeric(sOriginalFileName) Then 
         CreateFileName = Val(sOriginalFileName) + Val(txtSTEP.Value) 
      End If 
   ElseIf optStartStep.Value Then 
      CreateFileName = lIndex  '* Val(txtSTEP.Value)
   End If 
End Function