How to export and save each worksheet as new workbook in Excel?

[MMM13]

Hi,

Im new to this site and in need of help!
I have the below macro code that splits the content in a workbook into individual worksheets and then exports the worksheets into a folder that is created via the macro.
The folder that is created is named with "today's" date, however I need the folder to be named "Email Folder".
This is because I have another macro that erases the folder once done with, which wont work because the date on the folder changes day by day.

Any guidance is appreciated, thanks in advance!

Sub SplitWorkbook()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
xWs.Copy
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case xWb.FileFormat
Case 51:
FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If Application.ActiveWorkbook.HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56:
FileExtStr = ".xls": FileFormatNum = 56
Case Else:
FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
Application.ActiveWorkbook.Close False
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

[mdmackillop]

Change

FolderName = xWb.Path & "\" & xWb.Name & " " & DateString

to

FolderName = xWb.Path & "\Email Folder"

[MMM13]

Thank you for the quick response and it has worked!
By any chance, could you advise me on how to speed the process of this macro up at all if possible?

Thank you again

[mdmackillop]

I don't think the process can be speeded up. You could possibly incorporate emailing of workbooks if required as here; then you could grab some coffee as the work gets done.

[MMM13]

Thank you, I'll check it out!