Sub uoload_data()
Dim s(40) As Integer
Dim Row As Integer
Dim i As Integer
i = 0
For Row = 7 To 39
s(i) = Sheets("Data").Cells(Row, 5).Value
i = i + 1
Next
Dim cn As Object
Dim rs As Object
Dim strSql As String
Dim strConnection As String
Dim AppPath As String
Set cn = CreateObject("ADODB.Connection")
AppPath = Application.ActiveWorkbook.Path
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Users\devi\Desktop\Ability.accdb;"
cn.Open strConnection
strSql = "INSERT INTO MyTable Values ('" & s(0) & " ',
'" & s(1) & " ','" & s(2) & " ','" & s(3) & " ' )"
Set rs = cn.Execute(strSql)
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
I have a excel sheet of 40 field. I would like to update all field to access database. while insert record into database i am using insert into statement. In the mean time i need to write all fields of array into insert into statement. So please help me out to compact statement.
You can use Join() here
strSql = "INSERT INTO MyTable Values ('" & Join(s, "','") & "')"
The values in s() are integers, but you're wrapping the values in single-quotes, so are your DB columns text-type?
If they are numeric columns then you should drop the single-quotes.
Related
an access newbie here. I am trying to write a VBA code to query from an SQL database, and append the values into an access table. For this, i wrote below code but so far, i could only write a query and create a connection to the server. But i don't know how to bring it into the access table. Can you help me with this?
Sub getInv()
Dim RowCount As Long, ColCount As Long
Dim cnn As Object
Dim RS As Object
Set cnn = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
Dim SQLQuery As String
SQLQuery = _
"SELECT " & _
"PSDDD.SDDPP, PSDDD.SPPRD " & _
"WHERE " & _
"PSDDD.SDDPP = '2244556'" & _
"ORDER BY " & _
"PSDDD.SDDPP ASC, PSDDD.SPPRD DESC "
ConnectString = _
"DRIVER={Client Access ODBC Driver (32-bit)};" & _
"UID=abbsx;PWD=password;" & _
"SYSTEM=ABCSQT;DBQ=SSTNCHP22DB;"
cnn.Open (ConnectString)
RS.Open SQLQuery, cnn
' I believe i should put the code for writing into access table here.
'Close the Recordset and Connection
RS.Close
cnn.Close
Set RS = Nothing
Set cnn = Nothing
Exit Sub
erden. I hope this code gives you inspiration to solve your problem.
Public Function appendSelectedStudentsIntoPoolTable(Interest As String) As Long
Dim rSQL As String, rParams As String
Dim aSQL As String, aParams As String
Dim sourceTable As String, targetTable As String
sourceTable = "tStudents"
targetTable = "tStudentsPool"
'Note for targetTable: ID column not set to autonumber because to preserve
'original data as in the source table. But you can use it as PK as long no
'duplication on IDs.
rParams = "PARAMETERS [par_interest] Text(50); "
rSQL = rParams & "SELECT ID, Email, FirstName " & _
"FROM " & sourceTable & _
" WHERE Interest = par_interest;"
aParams = "PARAMETERS [par_ID] Long, [par_Email] Text(255), " & _
"[par_FirstName] Text(50); "
aSQL = aParams & "INSERT INTO " & targetTable & _
" (ID, Email, FirstName) " & _
"VALUES (par_ID, par_Email, par_FirstName);"
Dim db As DAO.Database
Dim rQDf As DAO.QueryDef
Dim aQdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim rec As Variant
Dim rsCount As Long 'change data type as needed
Dim appendedCount As Long 'same as rsCount data type
Dim i As Long 'same as rsCount data type
'On Error GoTo commit_failed
Set db = CurrentDb
Set rQDf = db.CreateQueryDef("", rSQL)
rQDf.Parameters("par_interest") = Interest
Set rs = rQDf.OpenRecordset()
With rs
On Error Resume Next: .MoveLast
On Error Resume Next: .MoveFirst
If .RecordCount > 0 Then
Do While Not rs.EOF
Set aQdf = db.CreateQueryDef("", aSQL)
aQdf.Parameters("par_ID") = !ID
'add routine(s) to check existing ID on pool table here
'before record append to pool table
'to prevent duplicate ID. For now, i skip it.
aQdf.Parameters("par_Email") = !Email
aQdf.Parameters("par_FirstName") = !FirstName
aQdf.Execute dbFailOnError
aQdf.Close
appendedCount = appendedCount + 1
.MoveNext
Loop
.Close
rQDf.Close
End If
End With
appendSelectedStudentsIntoPoolTable = appendedCount: Exit Function
commit_failed:
appendSelectedStudentsIntoPoolTable = 0
'You can put error handler here
End Function
I am newbie in connection of vba (excel) and oracle database. I have tried to look for some information but I could not find anything that would work for me.
I want to write a query that will return me only rows in which there is a specific values.
My query looks like this:
SQLStr = SQLStr = "SELECT NGKHFHCD, NGKHFNAM, NGKHGNKA, NGKHSZIC, NGKHMTRC, NGKHSNZC, NGKHGCHC, NGKHKKKS, NGKHKTKS FROM NGKH order by NGKHFHCD"
But I want to have something that will be like this SQLStr = "SELECT NGKHFHCD, NGKHFNAM, NGKHGNKA, NGKHSZIC, NGKHMTRC, NGKHSNZC, NGKHGCHC, NGKHKKKS, NGKHKTKS FROM NGKH WHERE NGKHFHCD = SHeet1(A2:A)"
I just don't want to pull out whole table from oracle, because it will take a lots of time so I thought that maybe I can return only specific rows from that table.
Also if there is no searched value in the table I would like to mark it in someway.
Is there anyway to solve it?
my code:
Sub OracleLocalConnect()
Dim RecordSet As New ADODB.RecordSet
Dim con As New ADODB.Connection
Dim ExcelRange As Range
Dim SQLStr As String
Dim ws As Worksheet
con.ConnectionString = "Provider=OraOLEDB.Oracle.1;User ID=***;Password=****;Data Source=*****;"
con.Open
Set RecordSet = CreateObject("ADODB.Recordset")
SQLStr = "SELECT GNKHFHCD, GNKHFNAM, GNKHGNKA, GNKHSZIC, GNKHMTRC, GNKHSNZC, GNKHGCHC, GNKHKKKS, GNKHKTKS FROM GNKH ORDER BY GNKHFHCD"
RecordSet.Open SQLStr, con, adOpenStatic, adLockReadOnly
Set ws = ActiveWorkbook.Sheets("Prices")
Set ExcelRange = ws.Range("A2")
ExcelRange.CopyFromRecordset RecordSet
RecordSet.Close
con.Close
Exit Sub
Exit Sub
End Sub
Untested but this would be close:
Sub OracleLocalConnect()
Dim RecordSet As New ADODB.RecordSet
Dim con As New ADODB.Connection
Dim ExcelRange As Range
Dim SQLStr As String
Dim ws As Worksheet
con.ConnectionString = "Provider=OraOLEDB.Oracle.1;User ID=***;Password=****;Data Source=*****;"
con.Open
Set RecordSet = CreateObject("ADODB.Recordset")
SQLStr = " SELECT GNKHFHCD, GNKHFNAM, GNKHGNKA, GNKHSZIC, GNKHMTRC, " & _
" GNKHSNZC, GNKHGCHC, GNKHKKKS, GNKHKTKS FROM GNKH " & _
" where " & InClause(Sheet1.Range("A2:A1000"), "GNKHFHCD", True) & _
" ORDER BY GNKHFHCD "
RecordSet.Open SQLStr, con, adOpenStatic, adLockReadOnly
Set ws = ActiveWorkbook.Sheets("Prices")
Set ExcelRange = ws.Range("A2")
ExcelRange.CopyFromRecordset RecordSet
RecordSet.Close
con.Close
End Sub
'Create an in clause for an Oracle query
Function InClause(rng As Range, colName As String, Optional quoted As Boolean = False)
'https://stackoverflow.com/questions/400255/how-to-put-more-than-1000-values-into-an-oracle-in-clause
Dim s As String, c As Range, qt As String, sep As String
qt = IIf(quoted, "'", "")
sep = ""
s = "(999, " & colName & ") in ("
For Each c In rng.Cells
If Len(c.Value) > 0 Then
s = s & sep & vbLf & "(999," & qt & c.Value & qt & ")"
sep = "," 'add comma after first pass
End If
Next c
InClause = s & ")"
End Function
I have tables that are created each month to reflect that month's records. I have created vba code that runs a query in excel on multiple months to show changes, new adds, etc. However, I would like the user to be able to choose the two months they would like to compare from an excel drop down box. I am struggling to create dynamic SQL that can do this. Below is my attempted code
`Private Sub ADO_New()
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim vCurrentMonth As Variant
Dim vPriorMonth As Variant
Dim wSummary As Worksheet
Set wSummary = Worksheets("Summary")
vCurrentMonth = wSummary.Range("Current_Month").Value
vPriorMonth = wSummary.Range("Prior_Month").Value
Worksheets("New").Cells.ClearContents
DBFullName = ThisWorkbook.Path & "\Guardian_CensusDB.accdb"
Set Connection = New ADODB.Connection
Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;"
Cnct = Cnct & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Cnct
Set Recordset = New ADODB.Recordset
With Recordset
Src = "SELECT * FROM [vCurrentMonth] LEFT JOIN [vPriorMonth] ON
[vCurrentMonth].[Plan Number] = [vPriorMonth].[Plan Number]" & _
"WHERE ((([vPriorMonth].[Plan Number]) Is Null))"
.Open Source:=Src, ActiveConnection:=Connection
For Col = 0 To Recordset.Fields.Count - 1
Sheets("New").Range("A1").Offset(0, Col).Value = _
Recordset.Fields(Col).Name
Next
Sheets("New").Range("A1").Offset(1, 0).CopyFromRecordset Recordset
End With
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
End Sub`
You need to concatenate the variables into your string:
Src = "SELECT * FROM [" & vCurrentMonth & "] LEFT JOIN [" & vPriorMonth & "] ON
[" & vCurrentMonth & "].[Plan Number] = [" & vPriorMonth & "].[Plan Number]" & _
"WHERE ((([" & vPriorMonth & "].[Plan Number]) Is Null))"
Basically, I have managed to retrieve the data from database to recordset by means of
rs=db.openrecordset(sql). How do I paste the data in the cell by UDF? Someone suggested array formula. Then how do i change recordset data to array? I know i can use copyfromrecordset . But it is not functioning in the UDF .
Thank you.
This is working for me with Excel 2003, ADO 2.8:
Function getArray(strSql As String) As Variant
Dim rs As ADODB.Recordset
Dim i As Integer
getArray = ""
Set rs = getRs(strSql)
With rs
.MoveFirst
Do
For i = 0 To .Fields.Count - 1
getArray = getArray & CStr(.Fields(i).Value) & " "
Next i
getArray = getArray & vbLf
.MoveNext
Loop Until .EOF = True
.Close
End With
Set rs = Nothing
End Function
It loops through all the rows/fields of a recordset and returns an "array" of values. It can be used as a workbook function without CSE.
This is how I'm making my db connection:
Function getRs(strSql As String) As ADODB.Recordset
Dim strCn As String
strCn = "Provider=sqloledb;Data Source=(local);Initial Catalog=AdventureWorks;Integrated Security=SSPI;"
Set getRs = New ADODB.Recordset
getRs.Open strSql, strCn, adOpenStatic, adLockReadOnly
End Function
And this is a sample of how I could retrieve some data using getArray() based on criteria from one cell and return the results into another (single) cell.
Function getEmpDataByLastName(strLastName As String) As Variant
Dim strSql As String
strSql = ""
strSql = strSql & "SELECT BusinessEntityID, PersonType, FirstName, COALESCE(MiddleName,'') AS MiddleName "
strSql = strSql & "FROM Person.Person "
strSql = strSql & "WHERE LastName = '" & strLastName & "' "
strSql = strSql & "ORDER BY FirstName "
getEmpDataByLastName = getArray(strSql)
End Function
I have a userform with one textbox and one combobox in EXCEL.
This userform is connected to a small data base (one table with 2 columns)
Combobox is populated with the values from the first column of databasqe table
I like when the combobox is changing the textbox to be automatic populated with the corespondent value from the second column.
I have the following code but it is not working:
Please, can someone help me?
Sub PopulateTB()
Dim rs As Recordset
Dim db As database
Dim SQL As String
Set db = OpenDatabase(ThisWorkbook.Path & "\materiale.mdb")
SQL = "SELECT values_col2 FROM table_db WHERE values_col1 = " & UserForm1.ComboBox1.Value & ";"
Set rs = db.OpenRecordset(sql)
Do Until rs.EOF = True
UserForm1.TextBox1.Value = rs.Fields(SQL)
rs.MoveNext
Loop
rs.Close
Set db = Nothing
Set rs = Nothing
End Sub
Thank you!
I putted like this and it is ok
Sub PopulateTB(ByRef ctl As Control, ByVal strTable As String, ByVal strField As String, Optional ByVal strCriteria As String)
Dim strSQL As String
Dim strSQLcount As String
Dim rs As Recordset
Dim db As Database
Dim rsCount As Recordset, totalCol As Long
Dim varRecords As Variant
Set db = OpenDatabase(ThisWorkbook.Path & "\materiale.mdb")
strSQLcount = ""
strSQLcount = strSQLcount & " " & "SELECT COUNT(*) AS Total FROM " & "[" & strTable & "]"
Set rsCount = db.OpenRecordset(strSQLcount)
totalCol = rsCount!Total
rsCount.Close
Set rsCount = Nothing
strSQL = ""
strSQL = strSQL & " " & "SELECT" & "[" & strField & "]"
strSQL = strSQL & " " & "FROM " & "[" & strTable & "]"
Set rs = db.OpenRecordset(strSQL)
varRecords = rs.GetRows(totalCol)
ctl.Value = varRecords(0, Me.ComboBox1.ListIndex)
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End Sub