Copying files out of SharePoint through ADO (1 Viewer)

Noblesongster01

New member
Local time
Today, 07:15
Joined
May 15, 2014
Messages
2
A tricky situation has come up and I could really use some help! I am trying to copy files attached to items in a SharePoint list. I have been able to open an ADO connection to the list and pull back a recordset. The Attachments field is a data type of dbLongBinary which is an OLE Object. I need help figuring out how to cycle through the attachments in each list item and save them to a file server. I have provided the code below that I have developed so far with an attempted solution commented out. Any ideas on how to solve this?

Sub ArchiveSharePointList(lngSharePointID As Long, strListName As String, strCriteriaSQL As String, lngDatabaseID As Long, strArchiveTable As String, Optional strAttachmentPath As String)
Dim cnxSharePoint As New ADODB.Connection
Dim rsADOSPRecords As New ADODB.Recordset
Dim cnxDatabase As New ADODB.Connection
Dim rsADODBRecords As New ADODB.Recordset
Dim rsDAOAttachments As DAO.Recordset
Dim dblFileNum As Double
Dim strSQL As String, strConnectionString As String
Dim lngRecordsAffected As Long

strConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;WSS;HDR=No;IMEX=2;ACCDB=YES;DATABASE=" & ProgramValue(lngSharePointID) & _
";LIST=" & strListName & ";VIEW=;RetrieveIds=Yes;TABLE=" & strArchiveTable
cnxSharePoint.Open strConnectionString
If cnxSharePoint.State = adStateClosed Then
MsgBox "Could not open connection to SharePoint.", vbCritical + vbOKOnly, "Error connecting"
Stop
End If
If cnxSharePoint.State = adStateOpen Then
OpenADORecordset "SELECT * FROM [" & strArchiveTable & "] WHERE " & strCriteriaSQL, cnxSharePoint, rsADOSPRecords
If rsADOSPRecords.State = adStateOpen Then
ConnectAccessADO lngDatabaseID, cnxDatabase
If cnxDatabase.State = adStateOpen Then
OpenADORecordset "SELECT * FROM [" & strArchiveTable & "]", cnxDatabase, rsADODBRecords
If rsADODBRecords.State = adStateOpen Then
dblFileNum = FreeFile
While Not rsADOSPRecords.EOF
strSQL = "INSERT INTO [" & strArchiveTable & "] (" & BuildFieldListADO(rsADOSPRecords, 21) & _
") SELECT " & BuildValueListADO(rsADOSPRecords, 21) & " FROM tblOneRecord"
cnxDatabase.Execute strSQL, lngRecordsAffected
' If Len(strAttachmentPath) > 0 Then
' Set rsDAOAttachments = rsADOSPRecords.Fields("Attachments").Value
' If rsDAOAttachments.RecordCount > 0 Then
' While Not rsDAOAttachments.EOF
' rsDAOAttachments.Fields("FileData").SaveToFile strAttachmentPath & "\" & rsADOSPRecords!ID & SplitPath(rsDAOAttachments!FileName, "File")
' rsDAOAttachments.MoveNext
' Wend
' End If
' End If
rsADODBRecords.MoveNext
Wend
End If
End If
End If
rsADOSPRecords.Close
Set rsADOSPRecords = Nothing
cnxSharePoint.Close
End If

End Sub

Function BuildFieldListADO(rsADOTemp As ADODB.Recordset, lngFieldCount As Long) As String
Dim intCounter As Integer

For intCounter = 1 To lngFieldCount
BuildFieldListADO = BuildFieldListADO & "[" & rsADOTemp.Fields(intCounter).Name & "], "
Next
BuildFieldListADO = Left(BuildFieldListADO, Len(BuildFieldListADO) - 2)
End Function

Function BuildValueListADO(rsADOTemp As ADODB.Recordset, lngFieldCount As Long) As String
Dim intCounter As Integer

For intCounter = 1 To lngFieldCount
If rsADOTemp.Fields(intCounter).Type = adInteger Or rsADOTemp.Fields(intCounter).Type = adLongVarBinary Or _
rsADOTemp.Fields(intCounter).Type = adDouble Or rsADOTemp.Fields(intCounter).Type = adDecimal Or _
rsADOTemp.Fields(intCounter).Type = adBoolean Or rsADOTemp.Fields(intCounter).Type = adBigInt Or _
rsADOTemp.Fields(intCounter).Type = adCurrency Or rsADOTemp.Fields(intCounter).Type = adNumeric Or _
rsADOTemp.Fields(intCounter).Type = adSmallInt Or rsADOTemp.Fields(intCounter).Type = adTinyInt Or _
rsADOTemp.Fields(intCounter).Type = adVarNumeric Then
BuildValueListADO = BuildValueListADO & Nz(rsADOTemp.Fields(intCounter), 0) & " AS Field" & intCounter & ", "
ElseIf rsADOTemp.Fields(intCounter).Type = adChar Or rsADOTemp.Fields(intCounter).Type = adLongVarChar Or _
rsADOTemp.Fields(intCounter).Type = adLongVarWChar Or rsADOTemp.Fields(intCounter).Type = adVarChar Or _
rsADOTemp.Fields(intCounter).Type = adVarWChar Or rsADOTemp.Fields(intCounter).Type = adWChar Then
BuildValueListADO = BuildValueListADO & "'" & Nz(rsADOTemp.Fields(intCounter), "") & "' AS Field" & intCounter & ", "
ElseIf rsADOTemp.Fields(intCounter).Type = adDate Or rsADOTemp.Fields(intCounter).Type = adDBDate Or _
rsADOTemp.Fields(intCounter).Type = adDBTime Or rsADOTemp.Fields(intCounter).Type = adDBTimeStamp Or _
rsADOTemp.Fields(intCounter).Type = adFileTime Then
If IsNull(rsADOTemp.Fields(intCounter)) Then
BuildValueListADO = BuildValueListADO & "Null AS Field" & intCounter & ", "
Else
BuildValueListADO = BuildValueListADO & "#" & rsADOTemp.Fields(intCounter) & "# AS Field" & intCounter & ", "
End If
End If
Next
BuildValueListADO = Left(BuildValueListADO, Len(BuildValueListADO) - 2) & " "
End Function
 

Users who are viewing this thread

Top Bottom