How to put a variable in a like statement in vba? - sql

I'm trying to get data from a db access using sql statement Like with a variable
The variable is a string "mrcTrx"
Go to the ******* in commentary to get direct to the point.
I know its not a big deal but I cannot find the answer thank you!
The rest of the code is fine cuz if I a put a value for exemple '05' the code works perfectly
Sub GetMun()
Dim cn As Object
Dim rs As Object
Dim intColIndex As Integer
Dim TargetRange As Range
Dim mrcMun As String
Dim mrcTrx As String
Dim reg As String
mrcTrx = Val(Range("D2").Value)
If Len(mrcTrx) < 2 Then
mrcTrx = "0" + mrcTrx
End If
Debug.Print mrcTrx
Dim totalGP As Integer
Dim debutRng As String
totalGP = Sheets("T1").Range("G247").Value
debutRng = "D" & 250 + totalGP
mrcMun = "D:\FicheMacro\Mun\PréparationTRX par Munic.mdb"
'On Error GoTo ErrorGetGPmun
Application.ScreenUpdating = False
Set TargetRange = Sheets("T1").Range(debutRng)
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & mrcMun
'*******
Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT MUNIC FROM Munic_en_MAJ_par_MRC WHERE MRC LIKE ' & mrcTrx & ' ", cn, , , adCmdText
TargetRange.CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Exit Sub
ErrorGetGPmun:
MsgBox "Valider le type de trx et l'entête de la T1", vbExclamation, "La Fiche! GP"
End Sub

You have the incorrect syntax
"SELECT MUNIC FROM Munic_en_MAJ_par_MRC WHERE MRC LIKE '" & mrcTrx & "'"
When placing a variable in a string be sure to use " and & properly in your syntax

Related

VBA & SQL how to select specific values based on range in excel?

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

Add list item to sharepoint list using vba

Im trying to create an excel tool that will add list item to sharepoint custom list. I had theinitial code but i am getying an error "couldnt find installable ISAM". My excel is 2016 and running in windows 10. How can i fix this issue?
Public Const sDEMAND_ROLE_GUID As String = "{6AA0B273-2548-49ED-9592-78243D4353AC}"
Public Const sSHAREPOINT_SITE As String = "https://eu001-sp.domain.com/sites/"
Sub TestPullFromSharepoint()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConn As String
Dim sSQL As String
Dim ID As String
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;DATABASE=" & sSHAREPOINT_SITE & ";" & _
"LIST=" & sDEMAND_ROLE_GUID & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=1;';"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
With cn
.ConnectionString = sConn
.Open
End With
sSQL = "SELECT tbl.[name] FROM [Library Name] as tbl where tbl.[id] = 14"
rs.Open sSQL, cn, adOpenStatic, adLockOptimistic
End Sub
I know it isn't super pretty, but I have a solution... Make sure that you replace YOURSHAREPOINTSITE with the url of your site.
The beauty of my solution, is that the code allows for:
Creation of new SP list
Addition of list items with all original column of the list
Addition of list items with any number of columns of the list (as
long as all required columns are represented)
No link required for the addition of new data (does create a link
when you use #1 but not a syncing link)
Limitations:
Column validation will cause a failed run if you pass data that
shouldn't go in that column (text to number column)
Absent required columns cause a failed run
Untested with lookup, people/group, or other record related column
types... but it would cause invalid data, potentially a failed run
unless you input the ID of the lookup value... which you probably
don't have.
It does require correct typing of column names and list name in
input boxes...
Public Sub PushSPList()
Dim lname As String, guid As String
Dim arr, arrr
Dim NewList As ListObject
Dim L As ListObjects
' Get the collection of lists for the active sheet
Set L = ThisWorkbook.ActiveSheet.ListObjects
' Add a new list
If MsgBox("Have you selected the new data?", vbYesNo) = vbNo Then
Exit Sub
Else
If MsgBox("New?", vbYesNo) = vbYes Then
lname = InputBox("What is the name of your new list?")
Set NewList = L.Add(xlSrcRange, Selection, , xlYes, True)
NewList.Name = lname
' Publish it to a SharePoint site
NewList.Publish Array("https://YOURSHAREPOINTSITE", lname), False
Else
arr = getSPitems
lname = arr(2)
guid = arr(1)
Set NewList = L(1)
Set arrr = Selection
Call addSPListItem(arrr, lname, guid)
End If
End If
End Sub
Sub addSPListItem(rar As Variant, lnme, guid)
Dim arr, lguid As String, spurl As String, lname As String, uitem As Object
lguid = guid
lname = lnme
spurl = "https://YOURSHAREPOINTSITE"
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset 'tb
Dim mySQL As String
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
mySQL = "SELECT * FROM [" & lname & "];"
With cnt
.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;" & _
"DATABASE=" & spurl & _
";LIST=" & lguid & ";"
.Open
End With
rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic
Dim fld As Object
Dim arrr()
i = -1
For Each fld In rst.Fields
i = i + 1
ReDim Preserve arrr(0 To i)
arrr(i) = rst.Fields(i).Name
Next
Dim clmns
clmns = Split(InputBox("Select columns, separated by commas, no spaces after commas... " & Join(arrr, ", ")), ",")
Dim Colmns As Object
Set Colmns = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(clmns)
Colmns(i) = clmns(i)
Next
jj = 1
Do While rar(jj, 1) ""
rst.AddNew
For kk = 0 To UBound(clmns)
rst.Fields(Colmns(kk)) = rar(jj, kk + 1)
Next
jj = jj + 1
Loop
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
MsgBox "Done"
End Sub

EXCEL VBA - SQL String not returning data from Access

I am using Excel to produce a report based on data stored in Access. I ping one specific query to return a full data set based on the value of a cell. I have 3 other modules of the same type getting data from another query which work perfectly. The below gives me a head-ache as it does not return any record. When I go in access and create a dummy query using the same SQL string, Access is returning the records as expected. Anyone can help? Thanks,
Sub fc_GetPLP()
Dim Z_Connection As Object
Dim Z_Recordset As Object
Dim Z_OnlineOD As String
Z_OnlineOD = Sheet2.Range("F6").Value
Dim Z_Access_Path As String
Dim Z_Access_File As String
Z_Access_Path = Sheet2.Range("C2").Value
Z_Access_File = Sheet2.Range("C3").Value
Set Z_Connection = CreateObject("ADODB.Connection")
Z_Connection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Z_Access_Path & Z_Access_File
Set Z_Recordset = CreateObject("ADODB.RECORDSET")
Z_Recordset.activeconnection = Z_Connection
Z_SQL = "SELECT Q_SPA_Pricing.* FROM Q_SPA_Pricing WHERE (Q_SPA_Pricing.Qf_FAR_OD='" & Z_OnlineOD & "')"
Debug.Print Z_SQL
Z_Recordset.Open Z_SQL
Debug.Print Z_Recordset.EOF
Sheet4.Columns("B:H").Clear
Sheet4.Range("B2").CopyFromRecordset Z_Recordset
Z_Recordset.Close
Z_Connection.Close
Set Z_Connection = Nothing
End Sub
For example, the SQL I just returned is:
SELECT Q_SPA_Pricing.* FROM Q_SPA_Pricing WHERE (Q_SPA_Pricing.Qf_FAR_OD='PAR-SIN')
Which is as expected, but only in Access. Excel returns an empty Recordset.
Thanks,
Fred
try below code
Sub fc_GetPLP()
Dim Z_Connection As Object
Dim Z_Recordset As Object
Dim Z_OnlineOD As String
Z_OnlineOD = Sheet2.Range("F6").Value
Dim Z_Access_Path As String
Dim Z_Access_File As String
Z_Access_Path = Sheet2.Range("C2").Value
Z_Access_File = Sheet2.Range("C3").Value
Set Z_Connection = CreateObject("ADODB.Connection")
Z_Connection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Z_Access_Path & Z_Access_File
Set Z_Recordset = CreateObject("ADODB.RECORDSET")
Z_Recordset.activeconnection = Z_Connection
Z_SQL = "SELECT Q_SPA_Pricing.* FROM Q_SPA_Pricing WHERE (Q_SPA_Pricing.Qf_FAR_OD='" & Z_OnlineOD & "')"
Debug.Print Z_SQL
Z_Recordset.Open Z_SQL
'Debug.Print Z_Recordset.EOF
If Z_Recordset.EOF = False Then
Sheet4.Columns("B:H").Clear
Sheet4.Range("B2").CopyFromRecordset Z_Recordset
End If
Z_Recordset.Close
Z_Connection.Close
Set Z_Connection = Nothing
End Sub

VBA Syntax error (missing operator) in query expression 'PopID ='

The following code throws an error when trying to run it, I presume I've managed to actually connect to the database and I have a cell selected so not sure what's missing.
ERROR:
Syntax error (missing operator) in query expression 'PopID ='.
Ideally I would like to be able to list four cells that would go into four columns in access appending each time the macro is ran
Const TARGET_DB = "testdb.accdb"
Sub AlterOneRecord() 'not working yet
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim lngRow As Long
Dim lngID As String
Dim j As Long
Dim sSQL As String
'determine the ID of the current record and define the SQL statement
lngRow = ActiveCell.Row
lngID = Cells(lngRow, 1).Value
sSQL = "SELECT * FROM tblPopulation WHERE PopID = " & lngID
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.path & Application.PathSeparator & TARGET_DB
With cnn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;"
.Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:=sSQL, _
ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, _
LockType:=adLockOptimistic
'Load contents of modified record from Excel to Access.
'do not load the ID again.
For j = 2 To 7
rst(Cells(1, j).Value) = Cells(lngRow, j).Value
Next j
rst.Update
' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
I find it strange with them both being M$ products that this is not well documented or really really easy to perform. Maybe I'm going about it in the wrong way.
How could I make it contain cells A1 and B2 for example?
You need to quote strings
sSQL = "SELECT * FROM tblPopulation WHERE PopID = '" & lngID & "'"

Assistance with excel macro using multiple files

I have two excel files with related data.
I am trying to create a macro that will be able to query data from db.xls and fill data.xls with the proper values.
Hope the image will be self-explanatory.
I did not use excel macros until now so any suggestions are appreciated.
Thanks,
Alex
The core function
Private Function GetValues(dataFilePath$, dbFilePath$) As String
'///add a reference
'1. Microsoft ActiveX Data Objects 2.8 Library
Dim cn1 As New ADODB.Connection, cn2 As New ADODB.Connection
Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset
Dim resultstring$, pos&, sql$
Call dbConnect_xls(cn1, dataFilePath)
Call dbConnect_xls(cn2, dbFilePath)
Set rs1 = cn1.Execute("select *from [Sheet1$];")
While Not rs1.EOF
sql = "select *from [sheet1$] where type='" & rs1.Fields(0).Value & "';"
Set rs2 = cn2.Execute(sql)
While Not rs2.EOF
Dim rcount&, tmp$
rcount = rs2.Fields.Count
For pos = 0 To rcount - 1
tmp = tmp & vbTab & rs2.Fields(pos).Value
Next
resultstring = resultstring & tmp & vbCrLf
tmp = ""
rs2.MoveNext
Wend
rs2.Close
rs1.MoveNext
Wend
rs1.Close
cn1.Close
cn2.Close
GetValues = resultstring
End Function
the connecttion handler
Private Function dbConnect_xls(dbConn As ADODB.Connection, dbPath As String) As Boolean
On Error GoTo dsnErr
With dbConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
.Open
End With
dbConnect_xls = True
Exit Function
dsnErr:
Err.Clear
If dbConn.State > 0 Then dbConn.Close: Call dbConnect_xls(dbConn, dbPath)
dbConnect_xls = False
End Function
And the tester
Public Sub tester()
Dim d1$, d2$
d1 = InputBox("Enter datafile path:")
d2 = InputBox("Enter dbfile path:")
If Dir(d1) <> "" And Dir(d2) <> "" Then
Dim x$
x = GetValues(d1, d2)
MsgBox x
'Call GetValues("C:\data.xls", "C:\db.xls")
Else
MsgBox "Invalid path provided."
End If
End Sub
and could be invoked from immediate window
tester
Hope this helps.