Переименование файлов библиотеки документов SharePoint в Excel VBA - PullRequest
0 голосов
/ 02 ноября 2018

Мне нужно переименовать все файлы в библиотеке документов SharePoint.

Когда я загружаю все файлы на локальный диск C, код работает. Когда в проводнике Windows указывают на общий сетевой диск SharePoint «https: \ ...», он не работает.

Я могу переименовать файлы вручную через проводник Windows на этом общем сетевом диске SharePoint.

Я читаю по всем ячейкам столбца А листа «Microsoft», в котором упоминаются документы 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...