Save multiple attachments, in one email, using the subject line, and incrementing that name

I want to save multiple attachments, in one email, using the subject line, and incrementing that name.

Public Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem 'Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Integer
    Dim lngCount As Integer
    Dim strFile As String
    Dim strFolderpath As String
    Dim strFileName As String
    Dim objSubject As String
    Dim strDeletedFiles As String
    ' Get the path to your My Documents folder
    'strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next
    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")
    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection
    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice
    ' Set the Attachment folder.
    strFolderpath = "C:\Users\demkep\Documents\"
    ' Check each selected item for attachments.
    For Each objMsg In objSelection
    'Set FileName to Subject
    objSubject = objMsg.Subject
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    If lngCount > 0 Then
    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.
    For i = lngCount To 1 Step -1
    ' Get the file name.
    strFileName = objSubject & ".pdf"
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFileName
    Debug.Print strFile
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile
    Next i
    End If
    Next
    ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing 
    Set objOL = Nothing
End Sub

When I get an email with multiple attachments, this code will overwrite the last file.

I'd like to save (sometimes up to 30 .pdf files) as "emailsubject", "emailsubject(1)", "emailsubject(2)", "emailsubject(3)" etc.

You are not changing the filename within the loop. Something like

strFileName = objSubject & "(" & i & ").pdf"

should take care of that.

If you only want numbers if there is more than one attachment you can check lngCount before setting the name or use IIf

If lngCount > 1 Then
    strFileName = objSubject & "(" & i & ").pdf"
Else
    strFileName = objSubject & ".pdf"
End If

Or

strFileName = objSubject & IIf(lngCount>1, "(" & i & ")", "") & ".pdf"

---

You shouldn't use On Error Resume Next on your whole sub btw.