使用XMLHTTP删除Sharepoint文件

时间:2012-10-18 13:26:31

标签: sharepoint excel-vba automation xmlhttprequest vba

继续这项出色的工作,在这里: Batch copy files to SharePoint site

我现在可以通过点击按钮将我的压缩文件上传到Sharepoint。

我现在的问题是:如何使用相同的方法删除我上传的文件?

我稍微修改了代码,以便将不同的文件保存到不同的SharePoint文件夹中。 以下示例:

 
Public Sub CopyToSharePoint()

Dim xmlhttp Dim sharepointUrl Dim sharepointFolder Dim sharepointFileName Dim LstrFileName, strFilePath, strMonthYear, PstrFullfileName, PstrTargetURL As String Dim LlFileLength As Long Dim Lvarbin() As Byte Dim LvarBinData As Variant Dim fso, LobjXML As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim fldr As folder Dim f As File

'Parent Sharepoint sharepointUrl = "[SHAREPOINT PATH HERE]"

'Sets the Month%20Year strMonthYear = Format(Now(), "mmmm yyyy") & "\"

'File Path strFilePath = "[ARCHIVE DRIVE]" & strMonthYear

'Check to see if DRA for current month%20year exists If Len(Dir(strFilePath, vbDirectory)) = 0 Then MkDir "strFilePath" End If

Set LobjXML = CreateObject("Microsoft.XMLHTTP")

'Where we're uploading files from Set fldr = fso.GetFolder(strFilePath)

For Each f In fldr.Files

If Format(f.DateCreated, "dd/mm/yyyy") = Format(Now(), "dd/mm/yyyy") Then

If InStr(1, f.Name, "[FILESTRING1]", vbTextCompare) > 0 Then
sharepointFolder = "[SHAREPOINTSTRING1]/"
    ElseIf InStr(1, f.Name, "[FILESTRING2]", vbTextCompare) > 0 Then
    sharepointFolder = "[SHAREPOINTSTRING2]"
        ElseIf InStr(1, f.Name, "[DONOTUPLOADTHISFILE]", vbTextCompare) > 0 Then
        GoTo NextF:
            Else
            sharepointFolder = "[SHAREPOINTMAINFOLDER]"
End If

sharepointFileName = sharepointUrl & sharepointFolder & f.Name

PstrFullfileName = strFilePath & f.Name
LlFileLength = FileLen(PstrFullfileName) - 1

' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1

' Convert to variant to PUT.
LvarBinData = Lvarbin
PstrTargetURL = sharepointUrl & sharepointFolder & f.Name

' Put the data to the server, false means synchronous.
LobjXML.Open "PUT", PstrTargetURL, False

' Send the file in. LobjXML.Send LvarBinData

End If

NextF: Next f

Set LobjXML = Nothing Set fso = Nothing

End Sub

If InStr(1, f.Name, "[FILESTRING1]", vbTextCompare) > 0 Then sharepointFolder = "[SHAREPOINTSTRING1]/" ElseIf InStr(1, f.Name, "[FILESTRING2]", vbTextCompare) > 0 Then sharepointFolder = "[SHAREPOINTSTRING2]" ElseIf InStr(1, f.Name, "[DONOTUPLOADTHISFILE]", vbTextCompare) > 0 Then GoTo NextF: Else sharepointFolder = "[SHAREPOINTMAINFOLDER]" End If

1 个答案:

答案 0 :(得分:2)

我没有关闭对服务器的请求,哦! 在一个单独的实例中进行设置解决了它。

我没有将文件名转换为二进制文件,然后转换为变体文件,只是将其保存为字符串。 您必须省略LastCoder示例中给出的最后NOTHING的{​​{1}}。添加它会重现上面给出的运行时错误。

感谢你的帮助,LastCoder。 这是修改后的代码:

LobjXML.SEND