rurounisena
New Member
- Joined
- Apr 13, 2018
- Messages
- 7
When I run my code I get run time error 2147024843 and says it cannot save attachment. Can anyone help? Below is my code with debug in blue.
Sub SaveAttachmenttoSharePoint()
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myName As String
'Ask for destination folder
myOrt = "\\https://hub.cscinfo.com/teams/Lms/LmsCompliance/Canada%20ARR/Forms/AllItems.aspx"
'Work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'For all items do...
For Each myItem In myOlSel
'Point to attachments
Set myAttachments = myItem.Attachments
'If there are some...
If myAttachments.Count > 0 Then
'For all attachments do...
For i = 1 To myAttachments.Count
'Save them to destination
myName = myAttachments(i).DisplayName
myName = Replace(myName, "&", "_")
myName = Replace(myName, "/", "-")
myName = Replace(myName, "", "_")
myName = Replace(myName, ":", "_")
myName = Replace(myName, "?", "_")
myName = Replace(myName, Chr(34), "_")
myName = Replace(myName, "<", "_")
myName = Replace(myName, ">", "_")
myName = Replace(myName, "|", "_")
myAttachments(i).SaveAsFile myOrt & _
myName
Next i
End If
Next
'Release variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
Sub SaveAttachmenttoSharePoint()
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myName As String
'Ask for destination folder
myOrt = "\\https://hub.cscinfo.com/teams/Lms/LmsCompliance/Canada%20ARR/Forms/AllItems.aspx"
'Work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'For all items do...
For Each myItem In myOlSel
'Point to attachments
Set myAttachments = myItem.Attachments
'If there are some...
If myAttachments.Count > 0 Then
'For all attachments do...
For i = 1 To myAttachments.Count
'Save them to destination
myName = myAttachments(i).DisplayName
myName = Replace(myName, "&", "_")
myName = Replace(myName, "/", "-")
myName = Replace(myName, "", "_")
myName = Replace(myName, ":", "_")
myName = Replace(myName, "?", "_")
myName = Replace(myName, Chr(34), "_")
myName = Replace(myName, "<", "_")
myName = Replace(myName, ">", "_")
myName = Replace(myName, "|", "_")
myAttachments(i).SaveAsFile myOrt & _
myName
Next i
End If
Next
'Release variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub