I am trying to update a sharepoint list inside a folder. The structure us as below
NewGLJE Log_List_New : 2018 : 12 Dec 18
With the below code I am able to add a new item to the main folder which is NewGLJE Log_List_New however want to update in the 12 Dec 18 folder. the code is below
Option Explicit
Sub AddNew_SP()
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim mySQL As String
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
mySQL = "SELECT * FROM [NewGLJE Log_List_New];"
With cnt
.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=http://staging.gl.firstam.net/sites/IFSC/GL/;LIST={71D20BD2-393D-4055-AFC7-476BB8776DE3};"
.Open
End With
rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic
rst.AddNew
rst.Fields("JE/Batch Name") = "JE1234Test"
rst.Fields("Division") = "DBS"
rst.Fields("Description") = "TEST"
rst.Fields("Control Total") = "10000"
rst.Update
If CBool(rst.State And adStateOpen) = True Then rst.Close
Set rst = Nothing
If CBool(cnt.State And adStateOpen) = True Then cnt.Close
Set cnt = Nothing
End Sub
I tried editing the sql statement to include the sub folders, however that gives a syntax error.
Can anyone please help me how to get to updating the list in the sub folders.
Thanks
Related
I have been using disconnected recordsets for a few weeks now, typically retrieving data from SQL Server, disconnecting the rs and filtering/formatting in VBA. Now i'm trying to do the reverse and create a new ADO recordset from scratch, and then connect it to my database and use UpdateBatch to insert the recordset into the database without using a loop. I have a fully populated recordset at this point, hooked it back up to my connection string, and try UpdateBatch. Understandably, it has no information at this point about what table I'm trying to update (only Data Source and Initial Catalog via the connection string). Is there a recordset property that I use to provide the table in question? Additionally, the table I'm trying to import into has a GUID field (first field) that I have left blank on purpose in my disconnected recordset assuming that upon import, SQL Server would assign this GUID/primary key automatically.
The specific error I'm getting after "rs.UpdateBatch" is
Run-time error '-2147467259 (80004005)'"
Insufficient base table information for updating or refreshing.
I know I could use a loop and a SQL command "INSERT INTO ...". I'd like to use a recordset object though since those provide much more functionality as a container for data. One thing I haven't tried is to first retrieve a recordset from the table in question, then clear it and re-populate it with the new data so that the recordset itself retains all of the original database and table properties. If that's the only/best approach I can try that route too. I just wanted to see if it was possible to create an ADO recordset, populate it, and then insert it into a matching table of my choice.
dim rs as ADODB.Recordset
set rs = New ADODB.Recordset
With rs.Fields
.append "alias", adVarChar, 255
.append "textA", adVarChar, 255
.append ......
End With
rs.Open
rs.AddNew Array(0, 1, 2, ..., n), Array(val0, val1, val2, ..., valn)
rs.Update
call importRS(rs)
rs.close
set rs = nothing
After rs.update above some recordsets may need to go to a database, other recordset objects are just used to expedite filtering and sorting so I just use them as a convenient container and they'd never go to importRS()
However, IF I need to send the disconnected recordset to a database, i'd like to just pass the recordset object to another function that serves the purpose of opening the connection, sending the update, and closing the connection. The code below would serve that purpose which is why i'd like to wait to establish a connection until this point, right at the end after my rs is populated.
sub importRS(byref rs as ADODB.Recordset)
dim cn as ADODB.Connection
set cn = New ADODB.Connection
cn.ConnectionString = strConnection 'my connection string variable'
cn.Open
rs.ActiveConnection = cn
rs.UpdateBatch '-------error message appears on this line
cn.close
set cn = nothing
You can get the data, (wherever it may be) into an array and add to the recordset using a loop. Then then when the loop is finished, you do rs.updatebatch as follows:
Private Sub SaveToSQLSever()
Dim lngLastRow As Long
Dim arrySheet As Variant
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim strCn As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
strCn= "Provider=VersionOfSQL;User ID=*********;Password=*********;"
& _ "Data Source=ServerName;Initial Catalog=DataBaseName"
cn.Open strCn
On Error Goto exiting
'*********************************************************
'If the data is coming from a sheet
'Set to your Range
With Sheets("SheetName")
lngLastRow = .Range("A2").CurrentRegion.Rows _
(.Range("A2").CurrentRegion.Rows.Count).Row
arrySheet = .Range("A1:G" & lngLastRow).Value2
End With
'Else populate the array and pass it to this Sub
'*************************************************************
'Note the property parameters
'.Source = Table That you want to populate
With rs
.ActiveConnection = cn
.Source = "Select * from TableName"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.Open
End With
For i = LBound(arrySheet,1) To UBound(arrySheet,1)
rs.AddNew
For j = LBound(arrySheet,2) To UBound(arrySheet,2)
rs.Fields(j).Value = arrySheet(i,j)
Next j
rs.MoveNext
Next i
rs.UpdateBatch 'Updates the table with additions from the array
i = 0
'******************************************************************
'Note that you can also refer to the Field Names Explicitly Like So:
For i = LBound(arryData,1) To UBound(arryData,1)
With rs
.AddNew
.Fields("FieldName1").Value = arryData(i,1)
.Fields("FieldName2").Value = arryData(i,2)
.Fields("FieldName3").Value = arryData(i,3)
.Fields("FieldName4").Value = arryData(i,4)
.Fields("FieldName5").Value = arryData(i,5)
.Fields("FieldName6").Value = arryData(i,6)
.Fields("FieldName7").Value = arryData(i,7)
End With
Next i
rs.UpdateBatch
'******************************************************************
MsgBox "The data has successfully been saved to the SQL Server", _
vbInformation + vbOKOnly,"Alert: Upload Successful"
exiting:
If cn.State > 0 Then cn.Close
If rs.State > 0 Then rs.Close
Set cn = Nothing
Set rs = Nothing
End Sub
Edit: As per OP's request to pass an existing recordset to a SQL table, below should do so:
Private Sub SendRcrdsetToSQL(ByRef rsIn As ADODB.Recordset)
Dim arrySheet As Variant
Dim rsSQL As ADODB.Recordset
Dim cn As ADODB.Connection
Dim strCn As String
Set cn = New ADODB.Connection
strCn= "Provider=VersionOfSQL;User ID=*********;Password=*********;"
& _ "Data Source=ServerName;Initial Catalog=DataBaseName"
cn.Open strCn
On Error Goto exiting
Set rsSQL = New ADODB.Recordset
With rsSQL
.ActiveConnection = cn
.Source = "Select * from TableName"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.Open
End With
'disconnect the recordset and close the connection
Set rsSQL.ActiveConnection = Nothing
cn.Close
Set cn = Nothing
rsIn.MoveFirst
rsSQL.MoveLast
'Add the records from the passed recordset to the SQL recordset
Do While Not rsIn.EOF
With rsSQL
.AddNew
.Fields("FieldName1").Value = rsIn.Fields("FieldName1").Value
.Fields("FieldName2").Value = rsIn.Fields("FieldName2").Value
.Fields("FieldName3").Value = rsIn.Fields("FieldName3").Value
.Fields("FieldName4").Value = rsIn.Fields("FieldName4").Value
.Fields("FieldName5").Value = rsIn.Fields("FieldName5").Value
.Fields("FieldName6").Value = rsIn.Fields("FieldName6").Value
.Fields("FieldName7").Value = rsIn.Fields("FieldName7").Value
End With
rsIn.MoveNext
Loop
rsSQL.UpdateBatch
MsgBox "The data has successfully been saved to the SQL Server", _
vbInformation + vbOKOnly,"Alert: Upload Successful"
exiting:
If cn.State > 0 Then cn.Close
If rsIn.State > 0 Then rsIn.Close
If rsSQL.State > 0 Then rsSQL.Close
Set cn = Nothing
Set rsIn = Nothing
Set rsSQL = Nothing
End Sub
The only way I was able to get this to work was by running a query to build the structure of my Recordset. So your code becomes something like this:
Private Sub Command1_Click()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionString = "<your connection string>"
cn.CursorLocation = adUseClient
cn.Open
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = cn
rs.Open "select * from states where 1<>1", , adOpenStatic, adLockBatchOptimistic
rs.AddNew Array("Abbrev", "Name", "Region", "SchoolDataDirect"), Array("TN", "TestName", "MyRegion", 1)
Set rs.ActiveConnection = Nothing
cn.Close
ImportRS rs
End Sub
Private Sub ImportRS(ByRef rs As ADODB.Recordset)
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionString = "<your connection string>"
cn.CursorLocation = adUseClient
cn.Open
Set rs.ActiveConnection = cn
rs.UpdateBatch
Set rs.ActiveConnection = Nothing
cn.Close
End Sub
We are working on a small VBA code that transmits the content of an e-mail message in Outlook to SharePoint. Our code reads the e-mail and filters out some key components (which are stored in variables). We then use ADODB to create a new item in a SharePoint list.
For that we use the following code:
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim mySQL As String
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
mySQL = "SELECT * FROM [xxxx];"
With cnt
.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=xxxxxx;LIST={xxxxx};"
.Open
End With
rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic
rst.AddNew
rst.Fields("Titel") = TheName
rst.Fields("ValidFrom") = ValidFrom
rst.Fields("ValidUntil") = ValidUntil
rst.Fields("VersionNr") = Version
rst.Update
If CBool(rst.State And adStateOpen) = True Then rst.Close
Set rst = Nothing
If CBool(cnt.State And adStateOpen) = True Then cnt.Close
Set cnt = Nothing
However, we want to send the attachment of the e-mail (if there is an attachment) also to the sharepoint list, and we are at a loss how to achieve this. After some Googling we found that it is possible to upload the file to a document library, and then use a hyperlink in the sharepoint list to that document. But for us it is possible to have multiple files in one e-mail... Does somebody know a way to achieve this?
I connect Access database to Excel by VBA, importing data from a single table,"Category" , to the worksheet. code below but, instead of table, can I import Query that already exists in the database?
It show "error" when I change the Table name to the Query name in line 15.
'connection Declairation
Dim conn As ADODB.Connection
Dim data As ADODB.Recordset
Set conn = New ADODB.Connection
Set data = New ADODB.Recordset
' end of connection Declairation
conn.ConnectionString = ConstrAccess
conn.Open
On Error GoTo closeconnection
With data
.ActiveConnection = conn 'specfied the connection
.Source = "Category" ' works only for Table Type
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
On Error GoTo closerecordset
Datasheet.Range("a2").CopyFromRecordset data
On Error GoTo 0
closerecordset:
data.Close
closeconnection:
conn.Close
End Sub
Why don't you change to Recordset and TableDef? You won't need to open the DataBase either that way; Add a Reference (tools->references) for Microsoft Office xx.x Access database engine Object Library
Sub test()
Dim BDAnalyzed As Database
Dim RecordTable As Recordset
Dim RecordTableDef As TableDef
Dim CounterTitles As Long
Const DesiredQuery = "Title For Query"
Const PathToDB = "C:..."
Set BDAnalyzed = DBEngine.Workspaces(0).OpenDatabase(PathToDB)
Set RecordTable = BDAnalyzed.OpenRecordset(DesiredQuery, dbOpenDynaset)
Set RecordTableDef = BDAnalyzed.TableDefs(RecordTable)
For CounterTitles = 0 To RecordTableDef.Fields.Count - 1
MsgBox RecordTableDef.Fields(CounterTitles).Name
Next CounterTitles
End Sub
What do I need to add/modify to this code to have txtDisease1 be populated with the results of strSQL? As of now the textbox populates with the SQL query. I'm sure it is a simple fix but for the life of me I can not find the answer.
Private Sub btnDNA_Click()
Dim strSQL As String
strSQL = "SELECT LastName From Patient WHERE PatientID = 1"
Me.txtDisease1.Value = strSQL
End Sub
You can use DLookup function.
Me.txtDisease1.Value = DLookup("LastName", "Patient", "PatientID = 1")
I've not been able to test this, but I think this should work.
Private Sub btnDNA_Click()
Dim strSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
strSQL = "SELECT LastName From Patient WHERE PatientID = 1"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
Me.txtDisease1 = rs!LastName
rs.close
Set rs = Nothing
Set db = Nothing
End Sub
For more complex lookups or to hit other data sources, you can use ADO (requires reference to Microsoft Active X Data Objects)
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "SELECT TOP 1 LastName From Patient WHERE PatientID=1", _
CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
If Not rs.EOF Then Me.txtDisease1.Value = rs(0)
rs.Close
Set rs = Nothing
Hi I'm trying to program a file to get data from SQL to an array in VBA.
First I tried to use this code and worked with my computer, but after testing the file in other users computer I found the error type-2146825287 when the macro got to the place where it opens the connection. I'm not part of IT department so I will not be able to update the users Service Packs so I tried to reuse another code made by other user that worked for another file some years ago.
This was my first aproach:
Function ConsultaQueryADODB(ConexionString, Query) As Variant
Dim CnADODB As ADODB.Connection
Set CnADODB = New ADODB.Connection
CnADODB.ConnectionString = ConexionString
CnADODB.Open
Dim RsADODB As ADODB.Recordset
Set RsADODB = New ADODB.Recordset
/// Open RecordSet
Set RsADODB = CnADODB.Execute(Query)
///Keep the Recordset using an Array
Dim ArrayQuery As Variant
ArrayQuery = RsADODB.GetRows
RsADODB.Close
Set RsADODB = Nothing
ConsultaQueryADODB = ArrayQuery
End Function
In the old file I found, the programmer was able to connect to the DB and it worked in other users computers. This was his code:
Public Sub QueryBrand()
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
cn.ConnectionString = "driver={SQL Server};server=SERVERNAME;database=BDInfo;uid=Hello;pwd=Hi"
Dim rst As Object
cn.Open
Set rst = CreateObject("ADODB.Recordset")
Sql = "SELECT distinct Brand FROM BlablaTable order by Brand"
rst.Open Sql, cn, 1, 3
c = 0
f = 2
Sheets("Sheet1").Activate
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Do While Not rst.EOF
Hoja2.Cells(f, 2) = rst.Fields("Marca")
f = f + 1
rst.MoveNext
Loop
On Error Resume Next
rst.Close
cn.Close
Set cn = Nothing
Set rst = Nothing
End Sub
I tried to modify this code to use it like my first aproach to save the recorset to an array. Now I'm able to open the connection and to open the recordset, but I'm not able to use the GetRows Method cause it becomes an Error 3021. Again in my computer it runs well, but when I run it in another computer it doesnt.
This is my second aproach:
Function ConsultaQueryADODB(ConexionString, Query) As Variant
Set CnADODB = CreateObject("ADODB.Connection")
CnADODB.ConnectionString = ConexionString
Dim RsADODB As Object
CnADODB.Open
Set RsADODB = CreateObject("ADODB.Recordset")
'/// Open the RecordSet
RsADODB.Open Query, CnADODB
'///Save the recordset into an array
Dim ArrayQuery As Variant
ArrayQuery = RsADODB.GetRows '----HERE APPEARS AN ERROR 3021 in the others computers
RsADODB.Close
Set RsADODB = Nothing
ConsultaQueryADODB = ArrayQuery
CnADODB.Close
Set CnADODB = Nothing
End Function
Is there any alternative to populate an array without using the GetRows Method? Do you have some alternatives for this code o connection?
Thanks in advance for your help!
Try the following code below. If not records are returned, the array will be empty which you'll need to check.
Function ConsultaQueryADODB(ConexionString, Query) As Variant()
Set CnADODB = CreateObject("ADODB.Connection")
CnADODB.ConnectionString = ConexionString
Dim RsADODB As Object
CnADODB.Open
Set RsADODB = CreateObject("ADODB.Recordset")
'/// Open the RecordSet
RsADODB.Open Query, CnADODB
'///Save the recordset into an array
If Not RsADODB.BOF And Not RsADODB.EOF Then
ConsultaQueryADODB = RsADODB.GetRows()
End If
RsADODB.Close
Set RsADODB = Nothing
CnADODB.Close
Set CnADODB = Nothing
End Function