Dear Krabople:

Here are a couple of routines that may help. Modofy as necessary.

Sub MakeFolderAndSaveActiveBook()
   Dim foldername As String
   Dim filename As String
   Dim s As String
   Dim wb As Workbook
   foldername = "ggg" ' modify for folder name
   filename = "filename.xls"
   s = CreateFolder(foldername)
   If Len(s) > 0 Then
       MsgBox s, vbOKOnly, "Created"
       s = s & "\" & filename
       ActiveWorkbook.SaveAs s
       MsgBox s, vbOKOnly, "Created"
   Else
       MsgBox "Cannot Create Folder " & foldername, vbOKOnly, "Cannot
create folder"
   End If
End Sub

Function CreateFolder(folder As String) As String
   Dim p As Variant
   On Error GoTo Err
   CreateFolder = ""
   p = CurDir
   If Len(p) > 0 Then
       If Right(p, 1) <> "\" Then p = p & "\"
       p = p & folder
       MkDir p
       CreateFolder = p
   End If
Err:
End Function