Hello All,
Below is some code I have in MS Access 2007 VBA that uploads documents to our SharePoint site. It works perfectly with one exception. What I would like it to do once it is loaded to the site is to be placed in a master document library that is grouped by the report name. The report name is housed in a sharepoint field (FieldName="Report", FieldInternalName="Report", FieldType="SPFieldChoice") in which I have the GUID ('WPQ21d00fde5-84eb-4782-8dfc-d9b96a0400e7Report'). I would greatly appreciate any input at all.
thanks in advance!
Public Sub CopyToSharePoint()
On Error GoTo err_Copy
Dim xmlhttp
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Dim LlFileLength As Long
Dim Lvarbin() As Byte
Dim LobjXML As Object
Dim LstrFileName As String
Dim LvarBinData As Variant
Dim PstrFullfileName As String
Dim PstrTargetURL As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr As Folder
Dim f As File
Dim pw As String
Dim UserName As String
Dim RetVal
Dim I As Integer
Dim totFiles As Integer
Dim Start As Date, Finish As Date
sharepointUrl = "[http path to server]/[server folder to write to]"
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
Set fldr = fso.GetFolder(CurrentProject.Path & "\[folder with files to upload]\")
totFiles = fldr.Files.Count
For Each f In fldr.Files
sharepointFileName = sharepointUrl & f.Name
PstrFullfileName = CurrentProject.Path & "\[folder with files to upload]\" & 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 & 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
I = I + 1
RetVal = SysCmd(acSysCmdSetStatus, "File " & I & " of " & totFiles & " copied...")
Next f
RetVal = SysCmd(acSysCmdClearStatus)
Set LobjXML = Nothing
Set fso = Nothing
err_Copy:
If Err <> 0 Then
MsgBox Err & " " & Err.Description
End If
End Sub
Below is some code I have in MS Access 2007 VBA that uploads documents to our SharePoint site. It works perfectly with one exception. What I would like it to do once it is loaded to the site is to be placed in a master document library that is grouped by the report name. The report name is housed in a sharepoint field (FieldName="Report", FieldInternalName="Report", FieldType="SPFieldChoice") in which I have the GUID ('WPQ21d00fde5-84eb-4782-8dfc-d9b96a0400e7Report'). I would greatly appreciate any input at all.
thanks in advance!
Public Sub CopyToSharePoint()
On Error GoTo err_Copy
Dim xmlhttp
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Dim LlFileLength As Long
Dim Lvarbin() As Byte
Dim LobjXML As Object
Dim LstrFileName As String
Dim LvarBinData As Variant
Dim PstrFullfileName As String
Dim PstrTargetURL As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr As Folder
Dim f As File
Dim pw As String
Dim UserName As String
Dim RetVal
Dim I As Integer
Dim totFiles As Integer
Dim Start As Date, Finish As Date
sharepointUrl = "[http path to server]/[server folder to write to]"
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
Set fldr = fso.GetFolder(CurrentProject.Path & "\[folder with files to upload]\")
totFiles = fldr.Files.Count
For Each f In fldr.Files
sharepointFileName = sharepointUrl & f.Name
PstrFullfileName = CurrentProject.Path & "\[folder with files to upload]\" & 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 & 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
I = I + 1
RetVal = SysCmd(acSysCmdSetStatus, "File " & I & " of " & totFiles & " copied...")
Next f
RetVal = SysCmd(acSysCmdClearStatus)
Set LobjXML = Nothing
Set fso = Nothing
err_Copy:
If Err <> 0 Then
MsgBox Err & " " & Err.Description
End If
End Sub