尝试将Outlook上的电子邮件上传到sharepoint

时间:2018-04-12 20:53:20

标签: vba outlook

我正在尝试创建一个宏,让我可以将选定的电子邮件上传到共享点库。这就是我到目前为止所拥有的。当我运行宏时,电子邮件不会显示。还有什么我必须补充的还是我完全咆哮错误的树?有人可以帮忙吗?

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/"
    On Error Resume Next

    '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

0 个答案:

没有答案