How to save an Outlook attachment to SharePoint? - excel

Question

I created a function in Excel to save a specified attachment (Excel file) from a specified email to a file location.
My organisation has moved all of our files to Sharepoint. I tried to update my function using the SharePoint path, but it fails to save the attachment.
Function OpenEMailAttachment(Path As String, FileName As String, FindSubj As String, FindAttachName As String, SubFolder As Object)
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
Dim wb As Workbook
Dim sSubj As String
'~~> Outlook Variables for email
' Other options for email properties are:
' eSender = oOlItm.SenderEmailAddress
' dtRecvd = oOlItm.ReceivedTime
' dtSent = oOlItm.CreationTime
' sMsg = oOlItm.Body
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items
sSubj = oOlItm.Subject
Debug.Print sSubj & "-->" & FindSubj
If sSubj Like FindSubj Then
Debug.Print "Opening attachment"
If oOlItm.Attachments.Count <> 0 Then
For Each oOlAtch In oOlItm.Attachments
'~~> Download the attachment
If oOlAtch.FileName Like FindAttachName Then
Debug.Print Path & FileName
oOlAtch.SaveAsFile Path & FileName
Debug.Print Path & oOlAtch.FileName
oOlItm.UnRead = False
DoEvents
oOlItm.Save
On Error Resume Next
oOlItm.Move SubFolder
On Error GoTo 0
End If
Next
End If
End If
Next
'~~> FilePath is the file that we earlier downloaded
Set wb = Workbooks.Open(Path & FileName)
OpenEMailAttachment = FileName
End Function
The path I specified is like https://MyOrg.sharepoint.com/teams/FolderName/
and the FileName like File%20Name.xlsx

Answer 1

Try this.
Sub copyFilesTo_Sharepoint()
Dim srcFolder As String
Dim dstFolder As String
' source path
srcFolder = "WriteYourSourcePathHere"
' destination path
dstFolder = "\\MyOrg.sharepoint.com\teams\FolderName"
' copies all Excel files starting with 'myfiles' with extension 'xslx'
Call fs_cpyFilesToFolder(srcFolder, dstFolder, "myfile*.xlsx")
End Sub
Sub fs_cpyFilesToFolder(srcPath As String, dstPath As String, Optional FileExt As String = "*.xlsx")
Dim fso As Object: Set fso = CreateObject("scripting.filesystemobject")
' checks if source path has a '\'
If Right(srcPath, 1) <> "\" Then
srcPath = srcPath & "\"
End If
' checks if source path exists
If fso.FolderExists(srcPath) = False Then
MsgBox srcPath & " doesn't exist"
Exit Sub
End If
' checks if destination path exists
If fso.FolderExists(dstPath) = False Then
MsgBox dstPath & " doesn't exist"
Exit Sub
End If
' copies files to sharepoint
fso.CopyFile Source:=srcPath & FileExt, Destination:=dstPath
End Sub