Hi,
This code uses WebDAV to upload files automatically to SharePoint. I didn't write it, though. "Jeff Jones" did.
My question is, the code below doesn't have an error-trapping routine that notifies me, at run-time, if a file didn't successfully get uploaded to SharePoint. Instead, the code is "silent."
Thoughts from anyone on how the code below could be modified to tell the user at run-time if a file didn't get successfully uploaded to SharePoint? Is there a VB solution that I could append to this code?
Again, below is the code. I pulled it from
Thanks,
SL
-----------------------------------------------------------
' Written by Jeff Jones 3-30-2004. Pure freeware, please redistribute.
'=================================
'Use this function call to upload a single file
WebUploadFile "C:\file.txt", "[link=http://server/folder/file.txt][/url]",
"domain\user", "password"
'Use this function call and constant to upload a directory and all it's
subdirectories
Const basedir = "c:\temp"
WebUploadDir "", "[link=http://server/folder/][/url]", "domain\user", "password"
'====================== WebDAV upload single file
Function WebUploadFile (file, url, user, pass)
Dim objXMLHTTP
Dim objADOStream
Dim arrbuffer
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1
objADOStream.LoadFromFile file
arrbuffer = objADOStream.Read()
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objXMLHTTP.open "PUT", url, False, user, pass
objXMLHTTP.send arrbuffer
End Function
'====================== WebDAV upload directroy
Function WebUploadDir (dir, baseUrl, usr, pwd)
Set fso = CreateObject("Scripting.FileSystemObject")
If dir = "" Then dir = basedir
Set srcFolder = fso.GetFolder(dir)
Dim fl
Set files = srcFolder.files
For Each fl in files
Dim relpath
relpath = Right(fl.path,Len(fl.path)-Len(basedir)-1)
relpath = Replace(relpath, "\", "/")
WebUploadFile fl.path, baseUrl & relpath, usr, pwd
Next
Dim sf
Set subfold = srcFolder.SubFolders
For Each sf in subfold
Set f = fso.GetFolder(sf)
relpath = Right(f,Len(f)-Len(basedir)-1)
relpath = Replace(relpath, "\", "/")
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objXMLHTTP.open "MKCOL", baseUrl & relpath, False, usr, pwd
objXMLHTTP.send
WebUploadDir f , baseUrl, usr, pwd
Next
End Function
-----------------------------------------------------------
This code uses WebDAV to upload files automatically to SharePoint. I didn't write it, though. "Jeff Jones" did.
My question is, the code below doesn't have an error-trapping routine that notifies me, at run-time, if a file didn't successfully get uploaded to SharePoint. Instead, the code is "silent."
Thoughts from anyone on how the code below could be modified to tell the user at run-time if a file didn't get successfully uploaded to SharePoint? Is there a VB solution that I could append to this code?
Again, below is the code. I pulled it from
Thanks,
SL
-----------------------------------------------------------
' Written by Jeff Jones 3-30-2004. Pure freeware, please redistribute.
'=================================
'Use this function call to upload a single file
WebUploadFile "C:\file.txt", "[link=http://server/folder/file.txt][/url]",
"domain\user", "password"
'Use this function call and constant to upload a directory and all it's
subdirectories
Const basedir = "c:\temp"
WebUploadDir "", "[link=http://server/folder/][/url]", "domain\user", "password"
'====================== WebDAV upload single file
Function WebUploadFile (file, url, user, pass)
Dim objXMLHTTP
Dim objADOStream
Dim arrbuffer
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1
objADOStream.LoadFromFile file
arrbuffer = objADOStream.Read()
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objXMLHTTP.open "PUT", url, False, user, pass
objXMLHTTP.send arrbuffer
End Function
'====================== WebDAV upload directroy
Function WebUploadDir (dir, baseUrl, usr, pwd)
Set fso = CreateObject("Scripting.FileSystemObject")
If dir = "" Then dir = basedir
Set srcFolder = fso.GetFolder(dir)
Dim fl
Set files = srcFolder.files
For Each fl in files
Dim relpath
relpath = Right(fl.path,Len(fl.path)-Len(basedir)-1)
relpath = Replace(relpath, "\", "/")
WebUploadFile fl.path, baseUrl & relpath, usr, pwd
Next
Dim sf
Set subfold = srcFolder.SubFolders
For Each sf in subfold
Set f = fso.GetFolder(sf)
relpath = Right(f,Len(f)-Len(basedir)-1)
relpath = Replace(relpath, "\", "/")
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objXMLHTTP.open "MKCOL", baseUrl & relpath, False, usr, pwd
objXMLHTTP.send
WebUploadDir f , baseUrl, usr, pwd
Next
End Function
-----------------------------------------------------------