open in old directory save in new directory

[tim64]

I have this code and I want it to open a file in a directory that I
choose (it does that already), and then I wunt it to create a folder in
the folder I chose with the folders name plus a number. (example) I
choose a folder named project_test then
it converts the file, in the folder, detail.htm to detail.htm.wk4 then
it creates the sub-folder project_test0001 then saves detail.htm.wk4 in
it. Then the next time I run convertfiles when it creates the sub-folder
it creates project_test0002 etc. .



Code:
--------------------


Sub ConvertFiles()
'
'
Application.DisplayAlerts = False

'
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
MsgBox fd.SelectedItems(a)
Dim NextFile As String


NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
NextFile & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()


Loop
Next
End If

Application.DisplayAlerts = True


End Sub