The following changes to the macro named below should work
Sub SaveItem(olItem As MailItem)
'Graham Mayor - http://www.gmayor.com - Last updated - 04/03/2017
Dim fname As String
Dim fPath1 As String, fPath2 As String
Dim strPath As String
Const fRootPath As String = "\\server name\Projects\drawings\" 'Change the 'server name' as appropriate
fPath1 = InputBox("Enter the customer folder name in which to save the message." & vbCr & _
"The path will be created if it doesn't exist.", _
"Save Message")
fPath1 = Replace(fPath1, "\", "")
fPath2 = InputBox("Enter the project name and number.", _
"Save Message")
fPath2 = Replace(fPath2, "\", "")
strPath = fRootPath & fPath1 & "\" & fPath2
CreateFolders strPath
CreateFolders strPath & "\Sent"
CreateFolders strPath & "\Received"
If olItem.sender Like "*@gmayor.com" Then 'Your domain
fname = Format(olItem.SentOn, "yyyymmdd") & Chr(32) & _
Format(olItem.SentOn, "HH.MM") & Chr(32) & olItem.SenderName & " - " & olItem.Subject
fname = "\Sent\" & fname
Else
fname = Format(olItem.ReceivedTime, "yyyymmdd") & Chr(32) & _
Format(olItem.ReceivedTime, "HH.MM") & Chr(32) & olItem.SenderName & " - " & olItem.Subject
fname = "\Received\" & fname
End If
fname = Replace(fname, Chr(58) & Chr(41), "")
fname = Replace(fname, Chr(58) & Chr(40), "")
fname = Replace(fname, Chr(34), "-")
fname = Replace(fname, Chr(42), "-")
fname = Replace(fname, Chr(47), "-")
fname = Replace(fname, Chr(58), "-")
fname = Replace(fname, Chr(60), "-")
fname = Replace(fname, Chr(62), "-")
fname = Replace(fname, Chr(63), "-")
fname = Replace(fname, Chr(124), "-")
SaveUnique olItem, strPath, fname
lbl_Exit:
Exit Sub
End Sub