在Excel VBA中重命名SharePoint文档库文件

时间:2018-11-02 13:26:15

标签: excel vba sharepoint

我必须重命名SharePoint文档库中的所有文件。

当我将所有文件下载到本地C驱动器时,该代码有效。当在Windows资源管理器中指向共享的SharePoint网络驱动器“ https:\ ...”时,它将不起作用。

我可以通过Windows SharePoint Explorer在此共享的SharePoint网络驱动器上手动重命名文件。

我阅读了称为“ Microsoft”的工作表的A列的所有单元格,其中提到了SharePoint文档。字段oldFile和newFile的值都可以,但是一旦我指向共享的Sharepoint网络驱动器,“名称”功能就无法使用。

Sub RenameMicroSoft()

'Dim oldFile As Variant

Sheets("Sheet1").Select
Columns("A:A").Select
Selection.ClearContents
Row = 4
renfiles = 0
uitval = 0
Cells(1, 1) = "Renamed files:"
Cells(3, 1) = "Uitval"
folder = InputBox("Folder:", "Geef folder")
If folder = "" Then Exit Sub

If Right(folder, 1) <> "/" Then
    folder = folder + "/"
End If

Sheets("Microsoft").Select
For inprow = 2 To (Range("A2", Range("A2").End(xlDown)).Count + 1)

    Prefix = UCase(Left(Cells(inprow, 1), 6))
    If (Prefix = "RD NL ") Or (Prefix = "RD FR ") Or (Prefix = "RD UK ") Then
        poshyph = InStr(1, Cells(inprow, 1), " - ")
        posdot = InStr(1, Cells(inprow, 1), ".")
        lang = Mid(Cells(inprow, 1), 4, 2)
        oldFile = folder + Cells(inprow, 1)
        NewFile = folder + "Realdolmen_CV_" + Cells(inprow, 2) + "_" + lang
        If poshyph <> 0 Then
            NewFile = NewFile + Mid(Cells(inprow, 1), poshyph)
        Else
            NewFile = NewFile + Mid(Cells(inprow, 1), posdot)
        End If
        NewFile = Replace(NewFile, ".DOCX", ".docx")
        NewFile = Replace(NewFile, ".DOC", ".doc")

        'oldFile = Replace(oldFile, " ", "%20")
        'NewFile = Replace(NewFile, " ", "%20")

        'rename files
        'On Error Resume Next
        Name oldFile As NewFile
        Cells(inprow, 10) = NewFile
        renfiles = renfiles + 1
    Else
        If Left(oldFile, 14) <> "Realdolmen_CV_" Then
            Cells(Row, 1) = oldFile
            Row = Row + 1
            uitval = uitval + 1
        End If
    End If

Next

Sheets("Sheet1").Cells(1, 2) = renfiles
Sheets("Sheet1").Cells(3, 2) = uitval

End Sub

0 个答案:

没有答案