I created a connection to REST API using PowerQuery in Excel2016 and it gets me information about companies.
In a certain query table, after the results are loaded, there is a column with ID of the company. Now, i want to be able to click on some id and this could be passed to my new query with this id as a parameter in a header. My connection string looks like this:
let
Source = Json.Document(Web.Contents("https://rejestr.io/api/v1/persons/"& Excel.CurrentWorkbook(){[Name="ID"]}[Content]{0}[Column1] &"/relations", [Headers=[Authorization="xxxxxxxxx"]]))
<..rest of the code, mainly formatting...>
in
"ColumnChanged"
Here im referencing the ID from a certain cell (user provided), but i want to be able to pass in this place a value from just selected cell on ID column and then a new query should be created and loaded onto a new worksheet.
I was thinking about this function to "get" a value cell from that column:
Worksheet_SelectionChange(ByVal Target As Range)
But i cannot figure out how to launch a new power query with that...
Alex
Generally, the idea is to avoid manipulating Power Query code directly via VBA (since you cannot be sure the result will be syntactically valid in M).
However, you genuinely seem to want to create a separate new sheet and query each time the user clicks an ID.
I therefore suggest you ignore my previous answer/approach and try the code below. I can't test the code (since I don't have my own credentials for this rejestr.io API) but I think it should work:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge <> 1 Then Exit Sub
If Intersect(Target.Parent.Range("ID"), Target) Is Nothing Then Exit Sub
' If there is any additional validation required (e.g. if the ID should be numeric,
' or should satisfy some condition/criteria) then it should be done here
' before proceeding to code below.
Dim idSelected As String
idSelected = Target.Value
Dim targetQuery As WorkbookQuery
Set targetQuery = GetOrCreateQueryFromId(idSelected)
Dim targetSheet As Worksheet
Set targetSheet = ThisWorkbook.Worksheets.Add
Dim targetTable As ListObject
Set targetTable = targetSheet.ListObjects.Add( _
SourceType:=0, _
Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & targetQuery.Name & ";Extended Properties=""""", _
Destination:=targetSheet.Range("$A$1") _
)
With targetTable.QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & targetQuery.Name & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "_" & targetQuery.Name
.Refresh BackgroundQuery:=False
End With
End Sub
Private Function GetOrCreateQueryFromId(ByVal someId As String) As WorkbookQuery
' Should accept an ID and return the existing WorkbookQuery object.
' If no query for the ID exists, this function should create one (and then
' return the newly created query).
Dim targetQuery As WorkbookQuery
On Error Resume Next
Set targetQuery = ThisWorkbook.Queries(someId)
On Error GoTo 0
Dim queryAlreadyExists As Boolean
queryAlreadyExists = Not (targetQuery Is Nothing)
Dim queryFormula As String
queryFormula = CreateQueryFormulaFromId(someId)
If queryAlreadyExists Then
targetQuery.Formula = queryFormula
Set GetOrCreateQueryFromId = targetQuery
Exit Function
End If
Set GetOrCreateQueryFromId = ThisWorkbook.Queries.Add(Name:=someId, Formula:=queryFormula)
End Function
Private Function CreateQueryFormulaFromId(ByVal someId As String) As String
' Given an ID, should return the Power Query code (code only) required to get data for that ID.
' This function returns the code itself only. It doesn't create the query object.
CreateQueryFormulaFromId = _
"let" & Chr(13) & "" & Chr(10) & _
" Source = Json.Document(Web.Contents(""https://rejestr.io/api/v1/krs/" & someId & "/relations"", [Headers=[Authorization=""x""]]))," & Chr(13) & "" & Chr(10) & _
" #""Converted to Table"" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error), " & Chr(13) & "" & Chr(10) & _
" #""Expanded Column1"" = Table.ExpandRecordColumn(#""Converted to Table"", ""Column1"", {""address"", ""business_insert_date"", ""ceo"", ""current_relations_count"", ""data_fetched_at"", ""first_entry_date"", ""historical_relations_count"", ""id"", ""is_opp"", ""is_removed"", ""krs"", ""last_entry_date"", ""last_entry_no"", ""last_state_entry_date"", ""last_state_entry_no"", ""legal_form"", ""name"", ""name_short"", ""nip"", ""regon"", ""type"", ""w_likwidacji"", ""w_upadlosci"", ""w_zawieszeniu"", ""relations"", ""birthday"", ""first_name"", ""krs_person_id"", ""last_name"", ""organizations_count"", ""second_names"", ""sex""}, " & _
"{""Column1.address"", ""Column1.business_insert_date"", ""Column1.ceo"", ""Column1.current_relations_count"", ""Column1.data_fetched_at"", ""Column1.first_entry_date"", ""Column1.historical_relations_count"", ""Column1.id"", ""Column1.is_opp"", ""Column1.is_removed"", ""Column1.krs"", ""Column1.last_entry_date"", ""Column1.last_entry_no"", ""Column1.last_state_entry_date"", ""Column1.last_state_entry_no"", ""Column1.legal_form"", ""Column1.name"", ""Column1.name_short"", ""Column1.nip"", ""Column1.regon"", ""Column1.type"", ""Column1.w_likwidacji"", ""Column1.w_upadlosci"", ""Column1.w_zawieszeniu"", ""Column1.relations"", ""Column1.birthday"", ""Column1.first_name"", ""Column1.krs_person_id"", ""Column1.last_name"", ""Column1.organizations_count"", ""Column1.second_names"", ""Column1.sex""})" & Chr(13) & "" & Chr(10) & _
"in" & Chr(13) & "" & Chr(10) & _
" #""Expanded Column1"""
End Function
If that is a genuine API key/credential in your question, then you may want to have the server provider revoke/change it (so that nobody can consume this service API using your credentials).
There is no error handling implemented and currently the user's input is not validated/sanitised in any way.
Hi I implemented your method. However i encountered 2 problems:
When I run the macro when im clicking on defined range and query is added, range is being "shortened" to only the field i just clicked on. So the "idselected" instead of A2:A10 now becames just A2...
The query is sucessfully added and parameter is succesfully passed but when i ran the query and the new sheet is added, the error occurs:
"The worksheet data for a table needs to be on the same sheet as the table"
My final VBA code looks like this now:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge <> 1 Then Exit Sub
If Intersect(Target.Parent.Range("Range5"), Target) Is Nothing Then Exit Sub
With ThisWorkbook
.Names("Range5").RefersTo = Target
.Queries.Add Name:="2-1_1", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Json.Document(Web.Contents(""https://rejestr.io/api/v1/krs/"" & Excel.CurrentWorkbook(){[Name=""Range5""]}[Content]{0}[Column1] & ""/relations"", [Headers=[Authorization=""xxxxxxx""]]))," & Chr(13) & "" & Chr(10) & " #""Converted to Table"" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error), " & Chr(13) & "" & Chr(10) & " #""Expanded Column1"" = Table.ExpandRecordColumn(#""Con" & _
"verted to Table"", ""Column1"", {""address"", ""business_insert_date"", ""ceo"", ""current_relations_count"", ""data_fetched_at"", ""first_entry_date"", ""historical_relations_count"", ""id"", ""is_opp"", ""is_removed"", ""krs"", ""last_entry_date"", ""last_entry_no"", ""last_state_entry_date"", ""last_state_entry_no"", ""legal_form"", ""name"", ""name_short"", ""nip"", ""regon"", ""type"", ""w_likwidacji"", ""w_upadlo" & _
"sci"", ""w_zawieszeniu"", ""relations"", ""birthday"", ""first_name"", ""krs_person_id"", ""last_name"", ""organizations_count"", ""second_names"", ""sex""}, {""Column1.address"", ""Column1.business_insert_date"", ""Column1.ceo"", ""Column1.current_relations_count"", ""Column1.data_fetched_at"", ""Column1.first_entry_date"", ""Column1.historical_relations_count"", ""Column1.id"", ""Column1.is_opp"", ""Column1.is_rem" & _
"oved"", ""Column1.krs"", ""Column1.last_entry_date"", ""Column1.last_entry_no"", ""Column1.last_state_entry_date"", ""Column1.last_state_entry_no"", ""Column1.legal_form"", ""Column1.name"", ""Column1.name_short"", ""Column1.nip"", ""Column1.regon"", ""Column1.type"", ""Column1.w_likwidacji"", ""Column1.w_upadlosci"", ""Column1.w_zawieszeniu"", ""Column1.relations"", ""Column1.birthday"", ""Column1.first_name"", ""Column1.krs_person_id"", ""Column1.last_name"", ""Column1.organizations_count"", ""Column1.second_names"", ""Column1.sex""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Expanded Column1"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=2-1_1;Extended Properties=""""" _
, Destination:=Range("$S$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [2-1_1]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "_2_1_1"
.Refresh BackgroundQuery:=False
End With
End With
I'm getting a run-time error 3075
I have checked all the parentheses and quotes, everything seems okay but still not running.
'Now Check the database to see if there are existing records for the Month and year in question
txtSQL = "SELECT Count([Rec_ID]) AS CountID FROM [dbo_NBD_EMEA_NBD_Source_Download] Where [Ledger_Year] = " & CurYear & " AND [Ledger_Month] = " & CurMonth & " AND ([Region_Cd] = 'EMEA' OR [Region_Cd] = 'APAC' OR [Region_Cd] = 'INDA');"
Set dbs = CurrentDb
Set Rs = dbs.OpenRecordset(txtSQL, dbOpenSnapshot)
NumRecs = Rs("CountID")
Rs.Close
If NumRecs > 0 Then
Prompt1 = "WARNING... There are " & NumRecs & " Records already in the database for Year " & CurYear & " Month " & CurMonth & Chr(10) & " Do you want to ERASE the existing records and REPLACE them with the NEW RECORDS in your IMPORT FILE " & Chr(10) & Selected_File & "?"
Response1 = MsgBox(Prompt1, Style2, "DELETE EXISTING RECORDS IN DATABASE?")
If Response1 = vbOK Then 'Continue with Delete of existing Records and Import of new
Prompt2 = "Confirm... Existing Records will be deleted and replaced with your new file"
Response2 = MsgBox(Prompt2, Style2, "Confirm Deletions")
If Response2 = vbOK Then
'Run Stored Procedure to delete the records
Me.ProcessStatus.Caption = "Deleting existing records"
Set db = DBEngine.Workspaces(0).OpenDatabase("", False, False, Connect_String)
db.Execute "XPROC1_NBD_EMEA_Source_Download_Delete " & CurYear & " , " & CurMonth, dbSQLPassThrough
Set db = Nothing
Else
If Response2 = vbCancel Then 'If no confirmation of delete then cancel
Me.ProcessStatus.Caption = "Import Canceled"
Exit Sub
End If
End If
Else
If Response1 = vbCancel Then ' Cancel import
Me.ProcessStatus.Caption = "Import Canceled"
Exit Sub
End If
End If
End If
This line does not look to be valid SQL:
db.Execute "XPROC1_NBD_EMEA_Source_Download_Delete " & CurYear & " , " & CurMonth, dbSQLPassThrough
The Execute method will run an action query or execute a supplied SQL statement, it does not evaluate VBA code within another database.
I want to hide or not show Field Names if value is Null, for fields "Location" and "Bin" when updating my eBay webpage Custom Label Fields.
Tried
If IsNull(Me!Location) Then
Me!Location.Visible = False
Else
Me!Location = True
but keep getting errors (Method or data not found or runtime 438) with the following code.
Call IE.Document.getElementById("editpane_skuNumber").setAttribute("value", ([CustomLabelCombine]) & " " & ("Location" & " " & [Location]) & " " & ("Bin" & " " & [Bin]))
If you have a better solution please let me know.
Is IE.Document.GetelementsbyID a subroutine or function? if not, remove the word "call" and replace with
me.Location = IE.Document.getElementById("editpane_skuNumber").setAttribute("value", ([CustomLabelCombine]) & " " & ("Location" & " " & [Location]) & " " & ("Bin" & " " & [Bin]))
If IsNull(Me!Location) Then
Me!Location.Visible = False
Else
Me!Location = True
End IF
Comment1:
When using "Call" you are asking the current procedure to "Call" a public subroutine. Example below
Private Sub Button1_Click()
Call TestRoutine
End Sub
Public Sub TestRoutine()
Msgbox "You clicked Button 1"
End Sub
If you aren't calling another subroutine to execute more coding, then remove the word "Call".
I also noticed your if is missing the .visible after the else for line
Me!Location = true
Should be:
Me!Location.Visible = true
I'm trying to update records in my form. It's a restaurant reservation system. Given the Table #, the form can let the user input the Customer ID of the person reserving, the reservation time and date. But when I click on the "update" button in my form, a text box will pop up with this:
And whatever I put in it, the runtime error "too few parameters. expected 1." pops up. Sometimes a "Reserved Error" will pop up. Could someone help me? It's the last step before I could finally finish this project.
This is my code for updating the record:
Private Sub Command8_Click()
On Error GoTo errHandling
Dim strSQL As String
strSQL = "UPDATE tblReserve SET CustomerID = " & """" & Me.txtCustID & """" & _
", ResDate = " & """" & Me.txtResDate & """" & ", ResTime = " & """" & Me.txtTime & """" & " WHERE TableNum =" & Me.TableNum
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
CurrentDb.Execute strSQL, dbFailOnError
DoCmd.Close
Exit Sub
errHandling:
MsgBox Err.Description
End Sub
Screenshot of VBA editor with Debug.Print strSQL
As revealed in our [chat][1], the essence of the problem was that [TableNum] is a text field and therefore its value had to be enclosed in quotes:
"... WHERE TableNum = '" & Me.TableNum & "'"
[1]: https://chat.stackoverflow.com/rooms/42746/discussion-between-nutellafella-and-gord-thompson)
Try something like this
strSQL = "UPDATE tblReserve SET CustomerID = " & Me.txtCustID & _
", ResDate = " & "'" & Me.txtResDate & "'" & ", ResTime = " & "'" & Me.txtTime & "'" & " WHERE TableNum =" & Me.TableNum
I am not sure why you have 2 sets of double quotes inside double quotes, I think what you were looking for is single quotes :)
However, there are much better ways to format sql than this. Also this seems like homework, so study up!
Finally the administrator configured the IIS for me the error message is listed below.
Set SQLStream = CreateObject("ADODB.Stream")
Set SQLConnection = CreateObject("ADODB.Connection")
Set SQLCommand = CreateObject("ADODB.Command")
Set SQLRecordSet = CreateObject("ADODB.RecordSet")
SQLConnection.Open "Provider=sqloledb;SERVER=SQLPROD;DATABASE=MyDataBase;UID=MyUsername;PWDMyPassword;"
'Response.Write("Connection Status: " & SQLConnection.State) & vbnewline
'Response.Write("Connection Provider: " & SQLConnection.Provider) & vbnewline
'Response.Write("Version: " & SQLConnection.Version) & vbnewline
SQLCommand.ActiveConnection = SQLConnection
SQLCommand.CommandText = "SELECT Seminars.Year, Seminars.SeminarID, Seminars.Theme, Seminar_Week.First, Seminar_Week.Last, Seminar_Week.WeekID, Seminar_Week.Date, Seminar_Week.Affiliation FROM Seminars CROSS JOIN Seminar_Week"
'Response.Write("SQL Command Passed in: " & SQLCommand.CommandText)
Set adoRec = SQLCommand.Execute()
file1 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & adoRec("Year") & "_" & adoRec("Last") & ".pdf"
file2 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & seminar_year & "_" & adoRec("Last") & "(handouts).pdf"
file3 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & seminar_year & "_" & adoRec("Last") & "_Flyer.pdf"
Set fso = CreateObject("scripting.filesystemobject")
Response.Write("<p style=" & "margin-left:10px;" & "><img src=" & "./img/right_arrowblue.png" & " alt=" & "Expand/Collapse" & " id=" & "arrow_" & adoRec("Week") & " /><strong>[" & adoRec("Date") & "]</strong> " & ""&aroRec("First") & adoRec("Last") & ", " & adoRec("Affiliation") & "</p>")
The very last line of code causes this error
ADODB.Recordset error '800a0cc1'
Item cannot be found in the collection corresponding to the requested name or ordinal.
FilePath, line 244
Line 244 is the very last line of code that should write Some information about each seminar on the webpage.
I'm pretty sure at this point I am pointing to an incorrect file path because I have an extra space somewhere in all the different string.
My question now is Would the ones in the very beginning, meaning the ones used in
"<p style=" & "margin-left:10px;" & "><img src=" & "./img/right_arrowblue.png"
be causing the trouble.
I'm also unfamiliar with using the "Expand/collapse" so if someone could tell me a little more about that. I am trying to fix someone elses code so I am a little behind the 8 ball.
One small step to a solution:
Your SQL
"SELECT * FROM Seminars WHERE [SeminarID] = 5 ORDER BY DESC"
is definitely wrong: ORDER BY needs (at least) a column name: ORDER BY [SeminarID] DESC.
If that does not solve all your problems, we'll have to think about a step by step approach.
If you get errors, tell us about them (number, description, line). That's what I meant, when I ask you to publish them. If you can't better info than "There was an error when processing the URL" from IIS, then you have to write some command line script to get the database related code absolutely right.
Start with experiments.vbs:
Dim sCS : sCS = !your connection string!
Dim oCN : Set oCN = CreateObject("ADODB.Connection")
oCN.Open sCS
WScript.Echo "CN open:", oCN.State
Dim sSQL : sSQL = !your SQL statement!
Dim oRS : Set oRS = oCN.Execute(sSQL)
WScript.Echo "RS EOF:", CStr(oRS.EOF)
WScript.Echo "Frs Col:", oRS.Fields(0).Name, oRS.Fields(0).Type
Dim i : i = 0
Do Until oRS.EOF
WScript.Echo i, oRS.Fields(0).Value
i = i + 1
oRS.MoveNext
Loop
oCN.Close
and run it in a command window (DOS box): cscript experiments.vbs. This should get you either some lines like:
CN open: 1
RS EOF: False
Frs Col: Id 3
0 ...
1 ...
2 ...
or a focused/publishable error message like:
... .vbs(2465, 14) Microsoft OLE DB Provider for SQL Server: Falsche Syntax in der Nä
he des 'DESC'-Schlüsselworts.
(bad syntax near DESC), which got when I tried the statement
"SELECT * FROM Alpha ORDER BY DESC"
RS.MoveNext
Put the above code on the line before the Loop keyword to avoid an infinite loop.
Are you missing the loop keyword at the end of your loop block?
Check the syntax here: http://msdn.microsoft.com/en-us/library/eked04a7.aspx