Instructing ADODB Recordset to use SQL Server current timestamp - sql-server-2008

I am attempting to write a number of records back to the database from a VB6 application using ADO. The records were read in from the database into an ADODB.Recordset and subsequently updated. I would like to be able to have each record in the set use the current date and time of the database server because I have no confidence that all our machines are time-synchronized. Is there a way to do this without having to query the database for CURRENT_TIMESTAMP (or something similar)? Ideally I'm hoping for some sort of flag that I can set the field value to so that the Recordset works this out on the database server.
See the question in my prototype code below (within the while-loop).
Dim oConn As ADODB.Connection
Dim oRs As ADODB.Recordset
Dim sSQL As String
Dim sColumnName1 As String: sColumnName1 = "UserNID"
Dim sColumnName2 As String: sColumnName2 = "Username"
Dim sColumnName3 As String: sColumnName3 = "LastLoginDTM"
' Open a connection.
Set oConn = New ADODB.Connection
oConn.Open 'my connection string was here
' Make a query over the connection.
sSQL = "SELECT TOP 10 " & sColumnName1 & ", " & sColumnName2 & ", " & sColumnName3 & " " & _
"FROM theTable"
Set oRs = New ADODB.Recordset
oRs.CursorLocation = adUseClient
oRs.Open sSQL, oConn, adOpenStatic, adLockBatchOptimistic, adCmdText
oRs.MoveFirst
While Not oRs.EOF
oRs.Fields(sColumnName3).Value = '-=-=-=-=-What do I put here???-=-=-=-=-
oRs.MoveNext
Wend
' Close the connection.
oConn.Close
Set oConn = Nothing

You could use the TSQL GetDate() Function
Change your Select to:
sSQL = "SELECT TOP 10 " & sColumnName1 & ", " & sColumnName2 & _
", " & sColumnName3 & ", GETDATE() AS ServerTimeStamp " & _
"FROM theTable"
Then, your code could be:
While Not oRs.EOF
oRs.Fields(sColumnName3).Value = oRS.Fields("ServerTimeStamp").Value
oRs.MoveNext
Wend

Related

can't update query in my db ,getting the error about updateable query

i am tring to update but id didn't work ....
' Database connection - remember to specify the path to your database
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.Jet.Oledb.4.0; Data Source=" & Server.MapPath("dbbb.mdb")
' Get data from the database depending on the value of the id in the URL
Dim strSQL
strSQL = "INSERT INTO people ("
strSQL = strSQL & "firstName , "
strSQL = strSQL & "lastName , "
strSQL = strSQL & "phone , "
strSQL = strSQL & "birthDate ) "
strSQL = strSQL & "VALUES("
strSQL = strSQL & "'Cousin', "
strSQL = strSQL & "'Gus', "
strSQL = strSQL & "'99887766', "
strSQL = strSQL & "'20-04-1964')"
' The SQL statement is executed
Set rs = Conn.Execute(strSQL)
' Close the database connection
rs.Close()
Set rs = Nothing
Conn.Close()
Set Conn = Nothing
I am getting the error
Operation must use an updateable query.
I must missed a space or something.... what can be the problem I seccuseed to read from the db but I can't update)
Do Not ever use "Execute" method to insert.
User ADODB.RecordSet Instead
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.Jet.Oledb.4.0; Data Source=" & Server.MapPath("dbbb.mdb")
Set Rs = Server.CreateObject("ADODB.RecordSet")
Rs.Open "Select Top 1 * From people", Conn,3,3
Rs.AddNew
Rs("firstName") = 'Cousin'
Rs("lastName") = 'Gus'
Rs("phone") = '99887766'
Rs("lastName") = CDate('20-04-1964')
Rs.Update
Rs.Close
Set Rs = Nothing
Conn.Close
Set Conn = Nothing
The problem is that the folder that your database is in does not have write permissions enabled for the user the website is running under.
Usually you need to give the user IUSR_ or IUSR read/write permissions to the MDB file or folder it is in. The user can vary depending on operating system/IIS versions/IIS settings.
If you provide some more details about your hosting environment we may be able to help further (eg. local or cliud, IIS version, control panel access, etc).

Access VBA to update Access table from SQL Server table source

I have created the code below to test whether I can run a query and retrieve a data from an SQL server table. And so far I can return the result using a MessageBox, but somehow I just don't know how to use this connection to update the table inside this Access file. Basically I want to use this as a front end file. Then, when the form is open it will automatically update the table inside this access file and load the data to the combo box as a list. I tried searching it here and read many discussions here and in Google but currently I can't find the right solution.
Option Compare Database
Sub LocalServerConn_Test()
Set conn = New adodb.Connection
Set rst = New adodb.Recordset
strDBName = "DataSet"
strConnectString = "Provider = SQLOLEDB.1; Integrated Security = SSPI; " & _
"Initial Catalog = " & strDBName & "; Persist Security Info = True; " & _
"Worksation ID = abc123;"
conn.ConnectionString = strConnectString
conn.Open
strSQL = "SELECT DISTINCT dbo.abc.abc123 FROM dbo.abc"
rst.Open Source:=strSQL, ActiveConnection:=strConnectString, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic
If rst.RecordCount = 0 Then
MsgBox "No records returned"
Else
rst.MoveFirst
Do While Not rst.EOF
MsgBox rst.Fields("abc123").Value
rst.MoveNext
Loop
End If
conn.Close
rst.Close
End Sub
You should be able to use code very similar to this:
Dim cdb As DAO.Database
Set cdb = CurrentDb
cdb.Execute _
"DELETE FROM LocalTable", _
dbFailOnError
cdb.Execute _
"INSERT INTO LocalTable (abc123) " & _
"SELECT DISTINCT abc123 " & _
"FROM " & _
"[" & _
"ODBC;" & _
"Driver={SQL Server};" & _
"Server=.\SQLEXPRESS;" & _
"Database=DataSet;" & _
"Trusted_Connection=yes;" & _
"].[dbo.abc]", _
dbFailOnError
Set cdb = Nothing
You can just keep the combo box bound to [LocalTable] and the updated values from the SQL Server table should appear.

how to create custom function in excel to grab mysql data?

We need to create a custom formula for users to pull data from our mysql database. After the user is authenticated, they would type in a formula in excel (something like '=retrievemybirthday("Frank Dodge")'. How do we go about doing that? We're not new to programming, just new to programming w/ Excel. Are there any tutorials on this? We've looked but can find anything.
thanks!
1) you need an ODBC driver configured for your MySQL db.
2) figure out the SQL code you need for this function, something like
select birthdate
from YourTable
Where membername=?
You will use this code in your function
3) In your function, you will need the correct Connection String. Check a site like http://www.connectionstrings.com/
4) Here's an example of a function, using ActiveX Data Objects (you need a reference set in Tools > References in the VB Editor)
Function GetNomen(sPN As String) As String
'SkipVought/2006 Mar 7
'--------------------------------------------------
' Access: DWPROD.FRH_MRP.READ
'--------------------------------------------------
':this function returns nomenclature for a given part number
'--------------------------------------------------
'2011-9-26 Converted to Parameter Query
'--------------------------------------------------
Dim sConn As String, sSQL As String, sServer As String
Dim rst As ADODB.Recordset, cnn As ADODB.Connection, cmd As ADODB.Command
Set rst = New ADODB.Recordset
Set cnn = New ADODB.Connection
Set cmd = New ADODB.Command
sServer = "dwprod"
cnn.Open "Driver={Microsoft ODBC for Oracle};" & _
"Server=" & sServer & ";" & _
"Uid=/;" & _
"Pwd="
sSQL = "SELECT PM.Nomen_201 "
sSQL = sSQL & "FROM FRH_MRP.PSK02101 PM "
sSQL = sSQL & "WHERE PM.PARTNO_201 =?"
Debug.Print sSQL
With cmd
.CommandText = sSQL
.CommandType = adCmdText
.Prepared = True
.Parameters.Append .CreateParameter( _
Name:="PARTNO_201", _
Type:=adChar, _
Direction:=adParamInput, _
Size:=16, _
Value:=sPN)
.ActiveConnection = cnn
Set rst = .Execute
End With
rst.MoveFirst
If Err.Number = 0 Then
GetNomen = rst("NOMEN_201")
Else
GetNomen = ""
End If
rst.Close
cnn.Close
Set cmd = Nothing
Set rst = Nothing
Set cnn = Nothing
End Function
You can run this function on the sheet as requested.

Error in VBA: Lost Connection to MySQL Server at 'reading authorization packet',system error 2

This is the error which I get after my macro executes for about 10 mins. The macro is basically performing the task to update the MySQL database every five seconds.
What could be wrong?
My macro is as below:
Public RunWhen As Double
Public Const cRunIntervalSeconds = 10 ' five seconds
Public Const cRunWhat = "UpdateMarketData" ' the name of the procedure to run
Sub UpdateMarketData()
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rad = 0
TextStrang = TextStrang & "'"
field2 = "cid"
field1 = "bid"
table1 = "MMbanner"
For rowCursor = 3 To 4
SQLStr = "UPDATE tbl_MarketData SET Mid = '" & Cells(rowCursor, 2) & "',Bid = '" & Cells(rowCursor, 5) & "',Offer = '" & Cells(rowCursor, 6) & "',DateEntered = '" & Format(DateTime.Now(), "yyyy-MM-dd hh:mm:ss") & "' WHERE IndexCode = '" & Cells(rowCursor, 1) & "'"
Debug.Print SQLStr
Set Cn = New ADODB.Connection
Cn.Open "DRIVER={MySQL ODBC 3.51 Driver};SERVER=<Servername>; PORT=Portno; DATABASE=Databasename; USER=Username; PASSWORD=Password; OPTION=0;"
Cn.Execute SQLStr
rad = rad + 1
Next
Set rs = Nothing
Cn.Close
Set Cn = Nothing
Call StartTimer
End Sub
Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=False
End Sub
Your for loop creates two separate connections via Set Cn = New ADODB.Connection etc but Cn.Close is only called once after the for loop. Therefore, the first connection created isn't explicitly closed and may still be considered active by the server. Eventually you'll run out of available connections and things will grind to a halt.
Not sure if this is the cause of your problem but it's definitely worth fixing. I would create and open the connection prior to the for loop but keep the Cn.Execute part within the body of the loop

Find unique row sets

I have a table in Access 2003 that has the following fields
Ptr_RateTable
MinOfWeight_Up_To
Adder
I need to find the unique values for MinOfWeight_Up_To for any table, without showing the table names in my results. I am trying to condense tables sizes in the mainframe by finding tables that can be condensed at the same weight breaks.
So for example
Ptr_RateTable|MinOfWeight_Up_To
1109LW020|1.00
1109LW020|2.00
1109LW020|6.00
1109LW020|11.00
1109LW020|101.00
1109LW020|128.00
1109LW020|129.00
1109LW021|1.00
1109LW021|2.00
1109LW021|3.00
1109LW021|11.00
1109LW021|36.00
1109LW021|41.00
1109LW021|151.00
I would like to see the following as a result and not make another "Profile" with the same weight breaks
Profile1|1.00|2.00|6.00|11.00|101.00|128.00|129.00
Profile2|1.00|2.00|3.00|11.00|36.00|41.00|151.00
First, you need a function that produces a signature for that table. Something akin to:
Public Function GetSignature(sTableName As String) As String
Dim oDB As DAO.Database
Dim oRS As DAO.Recordset
Dim sSQL As String
Dim sResult As String
sSQL = "Select Distinct MinOfWeight_Up_To" _
& vbCrLf & "From [" & sTableName & "]"
& vbCrLf & "Order By MinOfWeight_Up_To"
Set oDB = DBEngine.Workspaces(0).Databases(0)
Set oRS = oDB.OpenRecordset(sSQL, dbOpenForwardOnly, dbReadOnly)
Do Until oRS.EOF
sResult = sResult & "|" & Nz(oRS(0))
oRS.MoveNext
Loop
GetSignature = result
Set oRS = Nothing
Set oDB = Nothing
End Function
Once you have that, you would need another routine that assembles a list of the tables, calls the above signature for each table and stores the result in a temporary table. You would then query that temporary table for the unique list of signatures.
It should be noted that gazillions of string concatenations will be very slow. Instead you should look for implementations of a more efficient string builder class that you can use to build the signatures.
Using a crosstab query:
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
sSQL = "TRANSFORM Min(s.MinOfWeight_Up_To) AS Min_Weight " _
& "SELECT 'Profile' & Right([Ptr_RateTable],2) AS Profile " _
& "FROM Sample s " _
& "GROUP BY s.Ptr_RateTable " _
& "PIVOT s.MinOfWeight_Up_To"
rs.Open sSQL, cn
astr = rs.GetString
Do While InStr(astr, Chr(9) & Chr(9)) > 0
astr = Replace(astr, Chr(9) & Chr(9), Chr(9))
Loop
Debug.Print astr