Match file in database - sql

I have a problem where I can't get a 'msg box' that tells me files that I have browsed match with files in the database. I use an SQL Server database and I have already inserted data that matches with the files that I am browsing. This is my code:
Private Sub CmdUp_Click()
db
End Sub
Public Sub db()
Dim DBCon As ADODB.Connection
Dim Cmd As ADODB.Command
Dim Rs As ADODB.Recordset
Dim strName As String
Dim file As String
file = Text1.Text
Set DBCon = New ADODB.Connection
DBCon.CursorLocation = adUseClient
DBCon.Open "Driver={MySQL ODBC 3.51 Driver};Server=localhost;Port=3306;Database=mforce; User=root;Password=;Option=3;"
Set Cmd = New ADODB.Command
Cmd.ActiveConnection = DBCon
Cmd.CommandType = adCmdText
Cmd.CommandText = "SELECT Sample FROM static WHERE ID = 1"
Set Rs = Cmd.Execute
Do While Not Rs.EOF
Rs.MoveNext
Loop
If Form1.Text1.Text = strName Then
MsgBox " sample match"
End If
DBCon.Close
'Delete all references
Set Rs = Nothing
Set Cmd = Nothing
Set DBCon = Nothing
End Sub

Related

If i create a disconnected ADO recordset from scratch in VBA how do i set the base table information for UpdateBatch?

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

Retreiving Sharepoint List Data using vb.net

I want to retrieve SharePoint list data using VB.NET.
Below Code is for reference:-
Public Const roleGuid As String = "{8405ef03-40fl-4fan-8dl2-cf7kll1b8c1e}"
Public Const sharepointSite As String = "https://mysharepointsite.com/sites/resourceview.aspx"
Public Function getSharepointList()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConn As String
Dim sSql As String
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=1;RetrieveIds=Yes;" & _
"DATABASE=" & sharepointSite & ";" & _
"LIST=" & roleGuid & ";"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
With cn
.ConnectionString = sConn
.Open
End With
sSql = "SELECT * FROM [Student list] as [Student List];"
rs.Open sSql, cn, adOpenStatic, adLockOptimistic
ThisWorkbook.Worksheets("Sheet1").Range("A2").CopyFromRecordset rs
End Function
Below is error screenshot that gets popup
Any method or suggestion would be helpful.
I have found out a way to retrieve data from SharePoint list using vb.net
Public Function retrieveData()
'ADD FOLLOWING REFERENCES:-
'Microsoft ActiveX Data Objects 2.8 Library
'DECLARING CONNECTION AND RECORDSET OBJECTS, SQLQUERY STRING VARIABLE.
Dim cnt As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sqlQuery As String
'SETTING UP CONNECTION AND RECORDSET OBJECTS.
cnt = New ADODB.Connection
rs = New ADODB.Recordset
'HERE STUDENT LIST IS YOUR SHAREPOINT LIST NAME.
sqlQuery = "Select * from [Student List];"
'SETTING CONNECTION STRING TO CONNECTION OBJECT AND OPENING CONNECTION.
With cnt
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=2;RetrieveIds=Yes;DATABASE=https://mysharepointlist.com/sites/;LIST={Your List GUID};"
.Open()
End With
'OPENING RECORDSET.
rs.Open(sqlQuery, cnt, ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockReadOnly)
'FILLING DATATABLE WITH THE HELP OF DATA ADAPTER.
Dim myDa As OleDb.OleDbDataAdapter = New OleDb.OleDbDataAdapter
Dim myDs As DataTable = New DataTable
myDa.Fill(myDs, rs)
'FILLING DATAGRIDVIEW WITH DATATABLE AS DATASOURCE.
DataGridView1.Datasource = myDs
'CHECKS IF CONNECTION OBJECTS AND RECORDSET OBJECT IS IN OPEN STATE IF YES THEN IT WILL CLOSE AND DEREFERENCE THEM.
If CBool(rs.State And ADODB.ObjectStateEnum.adStateOpen) = True Then rs.Close()
rs = Nothing
If CBool(cnt.State And ADODB.ObjectStateEnum.adStateOpen) = True Then cnt.Close()
cnt = Nothing
End Function

How to Lock Only the Current ADODB.Recordset Instead of the Whole Page (or Table) in VBA/Access

I want to lock just the current ADODB recordset (but not the page or the entire table) of a multi-user system developed in VBA/Access so that any other user that opens the same recordset cannot edit one recordset position already in edit mode in some other user computer. I want to avoid 2 o more users editing the same record position (eg: more than one user editing the registration of the same employee).
I tested the folowing code, unsuccessfully:
Private Sub Form_Load()
Dim dbcon As ADODB.Connection
Dim recrdst As ADODB.Recordset
Set recrdst = New ADODB.Recordset
recrdst.CursorType = adOpenKeyset
recrdst.LockType = adLockPessimistic
Set dbcon = New ADODB.Connection
dbcon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Família\Alex Borges\Companies\Imobiliária Halex Tiago\Estudos\Sistema Multi-Usuário\Servidor.mdb;"
recrdst.Open "SELECT * FROM tblDependentes", dbcon
Set Me.Recordset = recrdst
Set recrdst = Nothing
Set dbcon = Nothing
End Sub
I also tested the folowing code:
Private Sub Form_Load()
Dim dbcon As ADODB.Connection
Dim recrdst As ADODB.Recordset
Set dbcon = New ADODB.Connection
dbcon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Família\Alex Borges\Companies\Imobiliária Halex Tiago\Estudos\Sistema Multi-Usuário\Servidor.mdb;"
Set recrdst = New ADODB.Recordset
recrdst.ActiveConnection = dbcon
recrdst.CursorType = adOpenKeyset
recrdst.LockType = adLockPessimistic
recrdst.CursorLocation = adUseServer
recrdst.Open "SELECT * FROM tblDependentes", dbcon
Set Me.Recordset = recrdst
Set recrdst = Nothing
Set dbcon = Nothing
End Sub
my Access version is 2007. on Access/Options/Advanced, I changed the default record locking to "edited record".
thanks in advance.

How can I change this code to SqlConnection?

Can anyone change this code to SqlConnection?
Dim Db As ADODB.Connection
Dim rs As ADODB.Recordset
Set Db = New ADODB.Connection
Db.ConnectionString = GetConnectString & AppPath & "schedule.mdb"
Call Db.Open
Set rs = New ADODB.Recordset
Set rs = Db.Execute("select * from tbl_Schedule where StartDate = #1/1/2002#")
While Not rs.EOF
Call Me.Schedule1.ScheduleItems.Add("", #1/1/2002#, rs!StartTime, _
rs!Length, rs!Description, "")
Call rs.MoveNext
Wend
Please find the below snippet which will helps you to get data from sql database. You can alter the script with your values. Import System.Data.SqlClient namespace to work with SqlConnection
Dim connection As New SqlConnection("Server=.\sqlexpress;Integrated security=sspi;database=Automation")
Dim query As String = "Select * from Heads"
If connection.State = ConnectionState.Closed Then connection.Open()
Using cmd As New SqlCommand(query, connection)
Dim reader As SqlDataReader = cmd.ExecuteReader
While reader.Read
ListBox1.Items.Add(reader("HeadName").ToString)
End While
reader.Close()
connection.Close()
End Using

Running stored procedure from Excel

I am trying to run a stored procedure from Excel. I know how to do it without using dynamic dates but I need the date range to be dynamic.
Sub TestStoredProcedure()
Dim CServer As String
Dim CDatabase As String
Dim CLogon As String
Dim CPass As String
Dim StartDate As Date
Dim EndDate As Date
Dim TStartDate As String
Dim TEndDate As String
CServer = "111111" ' Your server name here
CDatabase = "111111" ' Your database name here
CLogon = "11111111" ' your logon here
CPass = "111111" ' your password here
Dim Cmd1 As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim intTemp As Integer
Set Cmd1 = New ADODB.Command
Cmd1.ActiveConnection = cn
Cmd1.CommandText = "callstatisticsbyQ"
Cmd1.CommandType = adCmdStoredProc
Cmd1.Parameters.Refresh
Cmd1.Parameters(0).Value = Worksheets("Sheet2").Range("A1")
Cmd1.Parameters(1).Value = Worksheets("Sheet2").Range("A2")
Cmd1.Parameters(2).Value = Worksheets("Sheet2").Range("A3")
Set rs = Cmd1.Execute()
rs.Open Cmd1
Worksheets("Procedure Export").Range("A1").CopyFromRecordset rs
Call DumpSP("prcGetData", "", "", Worksheets("Procedure Export").Range("A1"))
End Sub
I get an error saying something about user defined type not defined.
To use ADO you click Tools->references in the VBA IDE & tick "Microsoft ActiveX Data Objects" - preferably the highest version thereof.
Additionally you use cn as the connection but its not defined in that sub (assuming its not global) & you will may need to Set Cmd1.ActiveConnection = cn.
Also take a look at this, it defines the input (adParaminput) paramaters in advance rather than using .Refresh which is pretty inefficient (takes a trip to the server)
Update for example:
rem for create procedure callstatisticsbyQ (#i int, #c varchar(10)) as select 1234;
Dim cn As ADODB.Connection
Dim Cmd1 As ADODB.Command
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set Cmd1 = New ADODB.Command
Set Cmd1 = New ADODB.Command
cn.Open "Provider=SQLNCLI10;Server=1.2.3.4;Database=x;Uid=x; Pwd=x;"
Set Cmd1.ActiveConnection = cn
Cmd1.CommandText = "callstatisticsbyQ"
Cmd1.CommandType = adCmdStoredProc
Cmd1.Parameters.Append Cmd1.CreateParameter("p1", adInteger, adParamInput, , Worksheets("Sheet2").Range("A1"))
Cmd1.Parameters.Append Cmd1.CreateParameter("p2", adVarChar, adParamInput, 20, Worksheets("Sheet2").Range("A2"))
Set rs = Cmd1.Execute()
MsgBox rs(0)
rs.Close
cn.Close