Save a file with Names - vba

Question

I have a form in word, whenever a submit is clicked upon it send a notification to email address and saves the file to a location. I have a script as below, I want when the data is input in the form and clicked on submit for 2nd time the saved file should have a different name because if the below script is run again it will overwrite the current form which is saved on that location.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
Doc.SaveAs2 "d:/abcd.docx"
With EmailItem
.Subject = "Test"
.Body = "Test"
.To = "jaiswalrohitkr#gmail.com"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub

Answer 1

You can use a global counter and the FileSystemObject to accomplish this.
'Global Variable to hold our iteration count
Public docCount As Integer
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Dim DocName As String
'add a reference to Microsoft Scripting Runtime
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
DocName = "d:/abcd.docx"
'use the fileSystemObject to check if the file already exists
Do While fso.FileExists(DocName) = True
DocName = "d:/abcd" & CStr(docCount) & ".docx"
'add one to the counter to check again
docCount = docCount + 1
Loop
Doc.SaveAs2 DocName
With EmailItem
If docCount > 0 Then
'more than one iteration so adjust name
.Subject = "Test" & CStr(docCount)
Else
'first iteration so leave it as test
.Subject = "Test"
End If
.Body = "Test"
.To = "jaiswalrohitkr#gmail.com"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub