Is it possible to do MDX queries using VBScript? I have successfully done SQL queries via VBScript, any idea on how to approach MDX queries?
Currently I use a connection string like the following:
strConn = "Driver={SQL Server};" & _
"Server=10.0.0.1;" & _
"Address=10.0.0.1,1433;" & _
"Network=DBMSSOCN;" & _
"Database=databasename;" & _
"UID=user;" & _
"PWD=password;"
What would I have to change it to to get it to work?
I think something like the following:
strConn = _
"Provider=MSOLAP.6;" & _
"Data Source=imxxxxxx;" & _ '<<<name of your server here
"Initial Catalog=AdventureWorksDW2012Multidimensional-EE;" & _ '<<<name of your Adv Wrks db here
"Integrated Security=SSPI"
Here is an example of using it against some mdx:
Dim pubConn As ADODB.Connection
Set pubConn = New ADODB.Connection
pubConn.CommandTimeout = 0
pubConn.Open strConn
Dim cs As ADOMD.Cellset
Set cs = New ADOMD.Cellset
Dim myMdx As String
myMdx = _
" SELECT" & _
" NON EMPTY" & _
" [Customer].[Customer Geography].[State-Province].&[AB]&[CA] ON 0," & _
" NON EMPTY" & _
" [Measures].[Internet Sales Amount] ON 1" & _
" FROM [Adventure Works];"
cs.Open myMdx, pubConn
The above is from my answer (in vba) here: VBA Reptitive MDX query to Analysis Services
Related
i'm in the process of roughing out a proof of concept for desktop software i'd like to develop. I'm using Access 2013.
The following code is supposed to analyse records in one table ('tblRestructures') and depending on the analysis it should then populate records in another table ('tblInScopeRestructures'). The sample data in tblRestructures is set up such that the code should cause there to be records with field(Gen) with values 1 to 6 inclusive. Sometimes the code does succeed in populating tblInScopeRestructures as expected but other times the code ends early (ie conditions for ending various loops are met). Despite a lot of time spent trying to identify the cause of the variability and looking for similar questions here, I am still none the wiser.
Any help here is gratefully received. And I apologise up front for my ugly code - I am not experienced and at this stage I am just trying to speed through a proof of concept.
Here is the code:
Public Function NbrOfShares3(strCode As String, dteDate As Date) As Single
Dim i As Integer
Dim strPrevCode1 As String
Dim adConn As ADODB.Connection
Set adConn = New ADODB.Connection
adConn.Open CurrentProject.Connection
Dim adrsa As ADODB.Recordset
Set adrsa = New ADODB.Recordset
adConn.Execute "DELETE * from tblInScopeRestructures"
adrsa.ActiveConnection = CurrentProject.Connection
adrsa.CursorType = adOpenStatic
' Identify all gen 1 (Code1 = CODE) restructures up to dteDate and put in a temp table
adrsa.Open "SELECT tblRestructure.Code1, tblRestructure.Code2, tblRestructure.RecDate " & _
"FROM tblRestructure " & _
"WHERE (((tblRestructure.Code1)='" & strCode & "')) AND (((tblRestructure.RecDate)<=#" & Format(dteDate, "mm/dd/yyyy") & "#));"
If adrsa.RecordCount <> 0 Then
adrsa.MoveFirst
Do While Not adrsa.EOF
adConn.Execute ("INSERT INTO tblInScopeRestructures(Code1,Code2,RecDate,Gen) VALUES ('" & adrsa.Fields("Code1") & "','" & adrsa.Fields("Code2") & _
"',#" & Format(adrsa.Fields("RecDate"), "mm/dd/yyyy") & "#," & 1 & ")")
adrsa.MoveNext
Loop
End If
i = 0
'Identify all code1 in
Dim adrsb As ADODB.Recordset
Set adrsb = New ADODB.Recordset
adrsb.ActiveConnection = CurrentProject.Connection
Do
i = i + 1
If adrsb.State = 1 Then
adrsb.Close
End If
adrsb.CursorType = adOpenStatic
adrsb.Open "SELECT tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
"FROM tblInScopeRestructures " & _
"GROUP BY tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
"HAVING (((tblInScopeRestructures.Gen)=" & i & "));"
Dim adrsc As ADODB.Recordset
Set adrsc = New ADODB.Recordset
adrsc.ActiveConnection = CurrentProject.Connection
adrsc.CursorType = adOpenStatic
If Not adrsb.EOF Then
adrsb.MoveLast
adrsb.MoveFirst
End If
If adrsb.RecordCount <> 0 Then
adrsb.MoveFirst
strPrevCode1 = adrsb.Fields("Code1")
Do While Not adrsb.EOF
If adrsc.State = 1 Then
adrsc.Close
End If
adrsc.CursorType = adOpenStatic
adrsc.Open "SELECT tblRestructure.Code1, tblRestructure.Code2, tblRestructure.RecDate " & _
"FROM tblRestructure " & _
"WHERE (((tblRestructure.Code2)='" & strPrevCode1 & "'));"
If adrsc.RecordCount <> 0 Then
adrsc.MoveFirst
Do While Not adrsc.EOF
adConn.Execute ("INSERT INTO tblInScopeRestructures(Code1,Code2,RecDate,Gen) VALUES ('" & adrsc.Fields("Code1") & "','" & adrsc.Fields("Code2") & _
"',#" & Format(adrsc.Fields("RecDate"), "mm/dd/yyyy") & "#," & i + 1 & ")")
adrsc.MoveNext
Loop
End If
adrsb.MoveNext
Loop
End If
Loop While adrsb.RecordCount <> 0
Debug.Print "finished"
End Function
Getting this error out of an old VB6 app that I've been presented with updating. So I got XP Mode up and running and VB6 installed and updated on it and I've added the menu option that was requested of me, but now I'm getting this error.
There are several examples of this error or similar here on SO and I looked through a bunch of them, but the circumstances aren't exactly the same and I'm still a pretty newbie developer and I just need help. I tested the query I wrote on our dev server and the VB syntax around it, that part is working fine. I think it has something to do with the result set logic near the end:
Private Sub FillDoor()
Dim m_rsDoor As ADODB.Recordset
cboDoorStyle.Clear
Set m_rsDoor = conSQL.Execute("SELECT bpm.[Description] " & _
"FROM tblBrandProductMaster bpm " & _
"INNER JOIN tblDoorStyles ds " & _
"ON ds.DoorStyleCode = bpm.Code " & _
"INNER JOIN tblFamilyDoorStyles fds " & _
"ON bpm.Code = fds.DoorStyleCode " & _
"INNER JOIN tblFamilyLines fl " & _
"ON fds.FamilyLineCode = fl.FamilyLineCode " & _
"WHERE fl.FamilyLineCode = '" & strFamID & "' " & _
"AND ds.DFFactive = 1 " & _
"ORDER BY bpm.[Description] ASC")
Do While Not m_rsDoor.EOF
cboDoorStyle.AddItem m_rsDoor!Description
m_rsDoor.MoveNext
Loop
Set m_rsDoor = Nothing
End Sub
****Edit: I'm using that query to populate a particular drop-down in the app and it is working on both on the SQL server and in the app.
Some of the examples on here use an If loop instead of a Do While Not, but they both get the same thing done and I don't think that's the issue. I also don't think that's the issue because I copied and pasted that part from another menu option on the app and that option works when I click it. It only throws the error when I choose the option I added.
Thanks, I appreciate any help anyone can offer.
Modify like below code:
Private Sub FillDoor()
Dim m_rsDoor As ADODB.Recordset
Set m_rsDoor = New Recordset
Dim ActiveConnection as String
ActiveConnection = "XXXXXXXXXXX"
Dim strSQL as String
strSQL = "SELECT bpm.[Description] " & _
"FROM tblBrandProductMaster bpm " & _
"INNER JOIN tblDoorStyles ds " & _
"ON ds.DoorStyleCode = bpm.Code " & _
"INNER JOIN tblFamilyDoorStyles fds " & _
"ON bpm.Code = fds.DoorStyleCode " & _
"INNER JOIN tblFamilyLines fl " & _
"ON fds.FamilyLineCode = fl.FamilyLineCode " & _
"WHERE fl.FamilyLineCode = '" & strFamID & "' " & _
"AND ds.DFFactive = 1" & _
"ORDER BY bpm.[Description] ASC"
m_rsDoor.open strSQL, ActiveConnection, adOpenStatic, adLockOptimistic
Do While Not m_rsDoor.EOF
cboDoorStyle.AddItem m_rsDoor!Description
m_rsDoor.MoveNext
Loop
Set m_rsDoor = Nothing
End Sub
This error comes when there are no record in the record set. Please check if your query is correct and giving records.
I'm a new user, so please go gentle on me.
I have created an Outlook rule that runs the below script which writes some of the email message properties to an SQL table.
The connection is working fine, when I run this as a macro on a selected message, it works fine... but when I leave it to run as a rule, it just keeps writing the currently selected email...
I can't figure out where I'm going wrong...
Code is below :
Sub TEST_TO_SQL(Item As MailItem)
Dim sSubject As String
Dim sTo As String
Dim sFrom As String
Dim sMsgeID As String
Dim sRcvd As Date
Set Item = Application.ActiveExplorer.Selection.Item(1)
sSubject = Item.Subject
sTo = Item.ReceivedByName
sFrom = Item.SenderEmailAddress
sMsgID = Item.EntryID
sRcvd = Item.ReceivedTime
Const adOpenStatic = 3
Const adLockOptimistic = 3
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
objConnection.Open _
"Provider=SQLOLEDB;" & _
"Data Source=SQLSERVER\SQLEXPRESS;" & _
"Trusted_Connection=Yes;" & _
"InitialCatalog=SQLDB;" & _
"User ID=sa;Password=password;"
objRecordSet.Open _
"INSERT INTO [SQLDB].[dbo].[EMAIL_Log] (LogCompanyID, LogSubject, LogStartDate, LogEndDate, LogShortDesc, LogLongDesc, LogFrom, LogTo, LogMessageID, LogCategory1)" & _
"VALUES ('11'," & "'" & sSubject & "'" & ", " & "'" & Format(sRcvd, "yyyy-mm-dd hh:mm:ss", vbUseSystemDayOfWeek, vbUseSystem) & "'" & ", '', 'short desc', 'Long Desc', " & "'" & sFrom & "'" & ", " & "'" & sTo & "'" & ", " & "'" & sMsgID & "'" & ", '47')", objConnection, adOpenStatic, adLockOptimistic
End Sub
You're always using the currently selected mail item. Remove the line:
Set Item = Application.ActiveExplorer.Selection.Item(1)
Then Item will be the one passed in to the Sub
I'm trying to get the datareport working since dataflexgrid is already working, although I'm having a hard time passing the values to datareport, I can't even pass one please help thanks.
PS. all of them are in one form
Set mRS = New ADODB.Recordset
mRS.CursorLocation = adUseClient
mRS.CursorType = adOpenForwardOnly
mRS.LockType = adLockReadOnly
If mRS.State = 1 Then mRS.Close
mRS.Open "SHAPE {" & _
"SELECT " & _
"space(memberstree.level*6) + customer.description, " & _
"customer.customercode, " & _
"customer.remarks, " & _
"customer.membersince " & _
"From CUSTOMER " & _
"INNER JOIN memberstree on customer.customercode = memberstree.customercode " & xRootNode & " " & _
"ORDER by memberstree.pedigree + ltrim(str(memberstree.node,6,0))} AS rsCustomer " & _
"APPEND (( SHAPE {SELECT transactionNo, logdate, customercode, GrandTotal " & _
"From FinishedTransaction where " & xCriteria & "} AS rsTransaction " & _
"APPEND ({SELECT TransactionNo, Description, Qty From FinishedSales} As rsSales " & _
"RELATE TransactionNo TO TransactionNo))" & _
" RELATE customercode TO customercode)", gCNMark
mRS.Requery
Set MSHFlexGrid1.DataSource = mRS
I think this is the code that isn't working
With rptShape
Set .DataSource = mRS
.DataMember = ""
With .Sections("FinishedSales_Detail").Controls
.Item("txtDescription").DataMember = "rsSales"
.Item("txtDescription").DataField = "Description"
End With
.Show 1
It's ok now I have 3 TABLE with 2 SHAPE Command but in the data report I have 3 Group Header and supposed to be 2 as well.
How can we create a hierarchical recordset without using SHAPE Command of MSDATASHAPE Provider?
As far as I can determine there is no direct way to accomplish this via the object model, i.e. without using the Data Shaping Service (Provider) and the Recordset.Open method.
As the documentation says though you can still use it to fabricate hierarchical Recordsets. Here is the example given:
Dim cn As New ADODB.Connection
Dim rsCustomers As New ADODB.Recordset
cn.Open "Provider=MSDataShape;Data Provider=NONE;"
strShape = _
"SHAPE APPEND NEW adInteger AS CustID," & _
" NEW adChar(25) AS FirstName," & _
" NEW adChar(25) AS LastName," & _
" NEW adChar(12) AS SSN," & _
" NEW adChar(50) AS Address," & _
" ((SHAPE APPEND NEW adChar(80) AS VIN_NO," & _
" NEW adInteger AS CustID," & _
" NEW adChar(20) AS BodyColor, " & _
" ((SHAPE APPEND NEW adChar(80) AS VIN_NO," & _
" NEW adChar(20) AS Make, " & _
" NEW adChar(20) AS Model," & _
" NEW adChar(4) AS Year) " & _
" AS VINS RELATE VIN_NO TO VIN_NO))" & _
" AS Vehicles RELATE CustID TO CustID) "
rsCustomers.Open strShape, cn, adOpenStatic, adLockOptimistic, -1
You should find this right in your MSDN Library CD documentation.