Save email message to SharePoint Doc library

Hi,

At the moment I have to map a drive to my doc lib and save that way using the following:

Sub SaveSelectedMessages()
Dim olItem As Outlook.MailItem
Dim fName As String
Dim fPath As String
Dim sNumber As String


On Error GoTo SaveFail

fPath = "Z:/"
For Each olItem In ActiveExplorer.Selection
sNumber = InputBox("Please enter Number for the email titled" & vbCrLf & vbCrLf & olItem.Subject)

If sNumber = "" Then
MsgBox ("You didn't enter a Number!" & vbCrLf & "Nothing has been saved please try again."), vbCritical
Set olItem = Nothing
Exit Sub
End If
fName = olItem.Subject
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), "-")
olItem.SaveAs fPath & fName & "{" & sNumber & "}" & ".msg"
MsgBox ("Save Completed Successfully")
Next olItem


Set olItem = Nothing

Exit Sub
SaveFail:
MsgBox ("An error has occured while trying to save the file, you may want to manulally upload instead. Please contact the Admin Team for assistance"), vbCritical
Set olItem = Nothing


End Sub

Is there a way to save directly to the SharePoint without mapping the drive?