Changing all excel workbook names in a folder code is not working

Hello everyone,

Hope everyone is having a great day!

I am having trouble getting this code to loop though a folder.

ActiveWorkbook.SaveAs Filename:=Cells(4, 6).Value & Cells(4, 7).Value & Cells(4, 8).Value

I am trying to rename all the excel workbooks in a folder, to corresponding cells in each workbook, the workbooks should be renamed using the values of the selected cells as follows,

F4G4H4
F4 is a proper name, G4 is a set of four numbers and F4 is also a set of four numbers. There aren't any illegal charaters in the cells I have selected.

The excel workbooks (will be 100's at a time) in the folder.
I have had success with the "loop" code with 3 other codes, this one gives me the 'A file named (me98981212, as an example) already exists in this location. Do you want to replace it? message box.

I can see the selected workbook open and the name of the file, in the title bar change. But, when I select Yes to the changes, the name of the excel file reverts back to the original name.

I don't need the message box to appear to confirm the change either.

Could someone provide some insight to this?

I hope I have provided enough information, to make the issue clear.

Here is the final code I am using.

Option Explicit

Sub Exec_Macro_For_All()

Dim sPath As String
Dim sFile As String
Dim sDir As String
Dim oWB As Workbook
Dim i1 As Long
Dim iMax As Long

On Error GoTo Err_Clk

sPath = "D:\loop test"
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

sDir = Dir$(sPath & "*.xls", vbNormal)
Do Until LenB(sDir) = 0
Set oWB = Workbooks.Open(sPath & sDir)

ActiveWorkbook.SaveAs Filename:=Cells(4, 6).Value & Cells(4, 7).Value & Cells(4, 8).Value

Application.ScreenUpdating = False

oWB.Save
oWB.Close False
sDir = Dir$
Loop

Err_Clk:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub

My Thanks in advance.