MS-Access in Sharepoint - what data available? - vba

For better or worse we are launching an Access db from Sharepoint. Note that this db is not PUBLISHED to SP, people just double-click the link and open the db on their desktops.
So now we need to begin imposing the equivalent of some roles-based edit restrictions. I know there is a VBA CurrentWebUser function and a CurrentWebUserGroups which provides some basic data about who's accessing an Office file from Sharepoint. However my reading and limited experimenting with this stuff leads me to suspect that, for Access at least, these will only work with published dbs, and not ones that are just being launched and run locally, like we're doing.
Is there anything I can get from SP in a case like this? Web user and user group would be useful, so would whichever site/page the link is being clicked on. Is any of this available?
Thanks.
rabbit

Well, not in any simple way.
As you've already determined, Application.CurrentWebUser just returns Null.
However, there are several ways to query the user information from SharePoint.
The recommended way (also by me) if you're going to work with SharePoint extensively, is to use the CSOM api, which requires a .Net language, so you'll have to create a COM module, authenticate it separately, and that's all a lot of work.
However, if you're only using simple GET requests, you can also use the REST API and re-use the authentication MS Access uses itself (since MS Access uses MSXML2 to submit web requests to SharePoint, we can create our own MSXML2.XMLHTTP object and it will re-use the cookies Access uses).
The following code uses the JSONInterpreter object I've shared here on GitHub. You could convert it to use XML and MSXML if you don't want that dependency, though.
To execute a request, I use the following code, that assumes the Access application is authenticated, but if it isn't, it connects to the SharePoint site using ADO.
(For this code, MySiteName is a global variable containing the URL of your SharePoint site, without a trailing slash)
Public Function SPRestGetJSON(Site As String, Request As String) As String
Dim tries As Long
Dim Success As Boolean
Do
'Try to execute request
tries = tries + 1
Dim xmlHttpReq As Object 'MSXML2.XMLHTTP60
Set xmlHttpReq = CreateObject("Msxml2.XMLHTTP.6.0") 'New MSXML2.XMLHTTP60
xmlHttpReq.Open "GET", Site & Request, False
xmlHttpReq.setRequestHeader "Content-Type", "application/json"
xmlHttpReq.setRequestHeader "Accept", "application/json;odata=nometadata"
xmlHttpReq.send
Dim root As JSONInterpreter
Set root = New JSONInterpreter
root.JSON = xmlHttpReq.responseText
If Not root.Exists("odata.error") Then
Success = True
End If
If Not Success And tries = 1 Then
'Connect to SharePoint using WSS + ADO to create auth cookies inside MSXML
Dim conn As Object 'ADODB.Connection
Set conn = CreateObject("ADODB.Connection") 'New ADODB.Connection
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;WSS;DATABASE=" & Site
On Error Resume Next
conn.Execute "SELECT 1 From SomeTable" 'Execute to non-existent table but connect to sharepoint
On Error GoTo 0
conn.Close
End If
Loop While tries < 2 And Success = False
SPRestGetJSON = xmlHttpReq.responseText
End Function
Then, we can use that in a simple function:
Public Function GetSPUsername() As String
Dim jsi As New JSONInterpreter
jsi.JSON = SPRestGetJSON(MySiteName, "/_api/Web/CurrentUser")
GetSPUsername = jsi.item("LoginName").VBAVariant
End Function
Getting groups is also available. This code returns an array of dictionary objects, you can view the available keys in the locals window:
Public Function GetSPGroups() As Variant 'Array of dictionaries
Dim jsi As New JSONInterpreter
jsi.JSON = SPRestGetJSON(SiteName, "/_api/Web/CurrentUser/Groups")
GetSPGroups = jsi.item("value").VBAVariant
End Function
Then, to get the title of the first group the current user is a member of in the immediate window, we can use:
?GetSPGroups(0)!Title

Related

How can I discover an "object access flag" that is apparently needed when deleting a Quickbooks invoice data entension using QBSDK

I am using the QuickBooks QBFC12 SDK, and specifically, I am attempting to delete a "data extension" on an invoice in QB.
Some of the time the following VB.NET code will work, but many times it doesn't:
Dim objRequest As IMsgSetRequest
Dim objDatExtAdder As IDataExtAdd
Dim objResponse As IMsgSetResponse
Dim objOurResponse As IResponse
Dim objInvoiceQuery As IInvoiceQuery
Dim objInvoiceRetList As IInvoiceRetList
Dim objInvoiceRet As IInvoiceRet
Dim szInvoiceTxnID As String = ""
Dim objDataExtDel As IDataExtDel
' Check to see if the invoice is already on file.
objInvoiceQuery = objRequest.AppendInvoiceQueryRq
objInvoiceQuery.ORInvoiceQuery.InvoiceFilter.MaxReturned.SetValue(1)
objInvoiceQuery.IncludeLineItems.SetValue(True)
objInvoiceQuery.IncludeLinkedTxns.SetValue(True)
objInvoiceQuery.ORInvoiceQuery.InvoiceFilter.ORRefNumberFilter.RefNumberFilter.MatchCriterion.SetValue(ENMatchCriterion.mcEndsWith)
objInvoiceQuery.ORInvoiceQuery.InvoiceFilter.ORRefNumberFilter.RefNumberFilter.RefNumber.SetValue(szQBInvoiceNumber)
objResponse = objSessionManager.DoRequests(objRequest)
objOurResponse = objResponse.ResponseList.GetAt(0)
If objOurResponse.StatusCode = 0 Then
' Lock onto the invoice.
objInvoiceRetList = objOurResponse.Detail
If objInvoiceRetList.Count > 0 Then
' The invoice already exists.
objInvoiceRet = objInvoiceRetList.GetAt(0)
szInvoiceTxnID = objInvoiceRet.TxnID.GetValue
End If
End If
objRequest.ClearRequests()
' Remove any previous value.
objRequest = objSessionManager.CreateMsgSetRequest("US", 11, 0)
objRequest.Attributes.OnError = ENRqOnError.roeStop
objDataExtDel = objRequest.AppendDataExtDelRq()
objDataExtDel.OwnerID.SetValue("0")
objDataExtDel.ORListTxn.TxnDataExt.TxnDataExtType.SetValue(ENTxnDataExtType.tdetInvoice)
objDataExtDel.ORListTxn.TxnDataExt.TxnID.SetValue(szInvoiceTxnID)
objDataExtDel.DataExtName.SetValue(szDataExtensionName)
objResponse = objSessionManager.DoRequests(objRequest)
objOurResponse = objResponse.ResponseList.GetAt(0)
If objOurResponse.StatusCode = 0 Then
Debug.Print("Worked")
Else
Debug.Print("Didn't work")
End If
On the occasions where it reports "Didn't Work," objourresponse.StatusMessage returns:
The necessary QuickBooks object access flag was not set in the attribute definition for an attribute. QuickBooks error message: Unknown Error
I have tried to understand what the "Object Access Flag" is and where it can be found, and I have searched on Google and the Intuit developer's site for more information, but I can't find anything.
Can someone help with understanding what this is, how I can get past this issue, and how I can consistently delete this data extension whenever necessary?
After a LOT of trial and error, I believe I have struck on a solution.
The particular extension was part of a drop-down selector that I have displayed on the invoice. Some of the valid values are "Printed" or "Shipped". Formerly, when I went to change the value in the extension, I was first deleting the extension using AppendDataExtDelRq, then adding it back in with the new value using AppendDataExtAddRq.
I was able to get the value to change if, instead of using the delete/add combination, I used AppendDataExtModRq and simply changed the value.
I still think there is a bug in the SDK like #InteXX suspects, but I also noticed that IF I set the extension to a pre-defined value in the drop-down, then all is good. BUT, if I try to set the extension to a value that isn't pre-defined in QB for that extension/drop-down, then I get the exact same error:
The necessary QuickBooks object access flag was not set in the attribute definition for an attribute. QuickBooks error message: Unknown Error
So the upshot is that it is working now by using the MOD and not the DELETE/ADD approach, but make sure you set the value to a pre-defined value.

Setting MS Access password at runtime in vb.net designer generated system

I am developing a VB.NET update system for a volunteer organisation’s MS Access database. The database is protected by a password as it contains personal information. I have created the application using the VB designer. I need to be able to code the application so that, if the owner decides to change the MS Access password, they will have no need to come back to me to change the code and rebuild the solution. In other words, I do not want the password to be hard coded in the app.config file or the settings.designer.vb file. My code should not need to know the password as a simple call to one of the Fill functions can test any password entered by the user. My problem is that I have found no way to alter the connection string that is tested in the setttings.designer.vb code whenever the database is accessed. I am using Visual Studio 2017.
I have spent a long time searching the web for answers and have tried various solutions involving the configurationmanager without success. I am new to this area so I would be most grateful if anyone here can help.
Here is my latest attempt which still produces an invalid password error even though the third debug statement suggests that the connection string, including the password, has been correctly set.
Public Sub UpdateConnString(connString As String)
Dim configFileMap As New ExeConfigurationFileMap()
Dim config As Configuration = ConfigurationManager.OpenExeConfiguration(configFileMap.ExeConfigFilename)
Dim connStringName As String = "TestConnectionString"
Debug.Print("0 " + config.ConnectionStrings.ConnectionStrings(connStringName).ConnectionString)
config.ConnectionStrings.ConnectionStrings(connStringName).ConnectionString = connString
Debug.Print("1 " + config.ConnectionStrings.ConnectionStrings(connStringName).ConnectionString)
config.Save(ConfigurationSaveMode.Modified, True)
Debug.Print("2 " + config.ConnectionStrings.ConnectionStrings(connStringName).ConnectionString)
End Sub
Just because a connection string is stored in the config file, you aren't required to use it as it is. You can read in that default value and then edit it before using it, e.g.
Dim builder As New OleDbConnectionStringBuilder(My.Settings.DefaultConnectionString)
builder.DataSource = dataSource
Dim connectionString = builder.ConnectionString
You can add or modify any part of a connection string you want that way at run time.
Thank you for your response. Unfortunately, the code throws a compilation error - "DefaultConnectionString is not a member of My.Settings".
Fortunatley I have now managed to find a working solution:
'My.Settings.Item("TestConnectionString") = connectionString

SAS EG asking for credentials "randomly" when called from VB

I have the following function in an Excel sheet module, which sends SQL queries to SAS:
Function run_query(query)
Dim app ' application
Dim project ' Project object
Dim sasProgram ' Code object (SAS program)
Set app = CreateObject("SASEGObjectModel.Application.5.1")
Set project = app.New
Set sasProgram = project.CodeCollection.Add
sasProgram.Text = "PROC SQL;" + query + " QUIT;"
sasProgram.Run
app.Quit
End Function
It sometimes works like a charm, and most often doesn't, as it asks for my credentials (triggered by command sasProgram.Run as it's where the debugger stops), I didn't find a way to make the error, or success, reproducible.
I've set my credentials persistence to Persist for user but I still have issues.
I've also tried to set my Autentification to None (attempt anonymous connection) and Windows integrated (Uses your current windows account) and none of them changed the situation.

Retrieve Lotus Notes Domino directoy groups and users

Using Studio 2013 VB.
I am attempting to retrieve group members from our Lotus Notes Domino directory - but I cannot get past this error: "A protocol error occurred. Failed, invalid authentication method specified." I was assuming (maybe incorrectly) that this could be done using DirectorySearcher as we do for our Active Directory.
I have tried retrieving various data with the same results. My research seems to indicate a problem with the ldapsettings but I am using the same alias and specific ldapsettings used by other in-house scripts (albeit written in perl). So the ldapsettings still might be the problem.
The line of code that fails is:
Dim result As SearchResult = searcher.FindOne
The value of searcher.Filter is (&(objectclass=dominoGroup)(cn=mydominogroup))
So this looks like it is build right.
Any help with errors in my code - or even suggestions to accomplish this task a better way are appreciated.
Here is my code:
dim grp as String = "mydominogroup"
Using dEntry As New DirectoryEntry("LDAP://mycompanyldapsettings")
dEntry.Username = myadminaccount
dEntry.Password = myadminpassword
Using searcher As New DirectorySearcher(dEntry)
searcher.Filter = String.Format("(&(objectclass=dominoGroup)(cn={0}))", grp)
Dim result As SearchResult = searcher.FindOne <--fails here
If result Is Nothing Then
"report group not found"
Else
Dim members As Object = result.GetDirectoryEntry.Invoke("Members", Nothing)
If members Is Nothing Then
"report no members found in group"
Else
For Each member As Object In CType(members, IEnumerable)
Dim currentMember As New DirectoryEntry(member)
If currentMember.SchemaClassName.ToLower = "user" Then
Dim props As PropertyCollection = currentMember.Properties
"get and list the user pros("someattribute").Value)"
End If
Next
End If
End If
End Using
End Using
Decided to call an external Process to solve this.

Query Tables (QueryTables) in Excel 2010 with VBA with VBA creating many connections

I'm following code I found on another site. Here's the basics of my code:
Dim SQL As String
Dim connString As String
connString = "ODBC;DSN=DB01;UID=;PWD=;Database=MyDatabase"
SQL = "Select * from SomeTable"
With Worksheets("Received").QueryTables.Add(Connection:=connString, Destination:=Worksheets("Received").Range("A5"), SQL:=SQL)
.Refresh
End With
End Sub
The problem with doing this is every single time they hit the button assigned to this it creates a new connection and doesn't ever seem to drop it. I open the spreadsheet after testing and there are many versions of the connection listed under Connections.
Connection
Connection1
Connection2
I can't seem to find a way to close or delete the connections either. If I add ".delete" after ".Refresh" I get a 1004 error. This operation cannot be done because the data is refreshing in the background.
Any ideas how to close or delete the connection?
You might ask yourself why you're creating a QueryTable every time in your code. There are reasons to do it, but it usually isn't necessary.
QueryTables are more typically design-time objects. That is, you create your QueryTable once (through code or the UI) and the you Refresh the QueryTable to get updated data.
If you need to change the underlying SQL statement, you have some options. You could set up Parameters that prompt for a value or get it from a cell. Another option for changing the SQL is changing it in code for the existing QueryTable.
Sheet1.QueryTables(1).CommandText = "Select * FROM ...."
Sheet1.QueryTables(1).Refresh
You can select different columns or even different tables by changing CommandText. If it's a different database, you'll need a new connection, but that's pretty rare.
I know that doesn't answer your question directly, but I think determining whether you really need to add the QueryTable each time is the first step.
For more on Parameters, see http://dailydoseofexcel.com/archives/2004/12/13/parameters-in-excel-external-data-queries/ It's for 2003, so there are few inconsistencies with later versions. The basics are the same, you just may need to learn about the ListObject object if you're using 2007 or later.
I had the same issue. The previous answer while a definite step in the right direction is a PITA.
It did however allow me to refine my search and the winner is...
http://msdn.microsoft.com/en-us/library/bb213491(v=office.12).aspx
i.e. for your existing QueryTable Object just do this:
.MaintainConnection = False
Works ever so swell. No more Access DB lock file after the data is refreshed.
You should declare the connection as a separate object then you can close it once the database query is complete.
I don't have the VBA IDE in front of me, so excuse me if there are any inaccuracies, but it should point you in the right direction.
E.g.
Dim SQL As String
Dim con As connection
Set con = New connection
con.ConnectionString = "ODBC;DSN=DB01;UID=;PWD=;Database=MyDatabase"
Worksheets("Received").QueryTables.Add(Connection:=con, Destination:=Worksheets("Received").Range("A5"), SQL:=SQL).Refresh
con.close
set con = nothing
I've found that by default new connections created this way are called "Connection". What I am using is this snippet of code to remove the connection but retain the listobject.
Application.DisplayAlerts = False
ActiveWorkbook.Connections("Connection").Delete
Application.DisplayAlerts = True
It can easily be modified to remove the latest added connection (or if you keep track of the connections by their index).
Application.DisplayAlerts = False
ActiveWorkbook.Connections(ActiveWorkbook.Connections.Count).Delete
Application.DisplayAlerts = True
Instead of adding another query table with the add method, you can simply update the CommandText Property of the connection. However you have to be aware that there is a bug when updating the CommandText property of an ODBC connection. If you temporarily switch to an OLEDB connection, update your CommandText property and then switch back to ODBC it does not create the new connection. Don't ask me why... this just works for me.
Create a new module and insert the following code:
Option Explicit
Sub UpdateWorkbookConnection(WorkbookConnectionObject As WorkbookConnection, Optional ByVal CommandText As String = "", Optional ByVal ConnectionString As String = "")
With WorkbookConnectionObject
If .Type = xlConnectionTypeODBC Then
If CommandText = "" Then CommandText = .ODBCConnection.CommandText
If ConnectionString = "" Then ConnectionString = .ODBCConnection.Connection
.ODBCConnection.Connection = Replace(.ODBCConnection.Connection, "ODBC;", "OLEDB;", 1, 1, vbTextCompare)
ElseIf .Type = xlConnectionTypeOLEDB Then
If CommandText = "" Then CommandText = .OLEDBConnection.CommandText
If ConnectionString = "" Then ConnectionString = .OLEDBConnection.Connection
Else
MsgBox "Invalid connection object sent to UpdateWorkbookConnection function!", vbCritical, "Update Error"
Exit Sub
End If
If StrComp(.OLEDBConnection.CommandText, CommandText, vbTextCompare) <> 0 Then
.OLEDBConnection.CommandText = CommandText
End If
If StrComp(.OLEDBConnection.Connection, ConnectionString, vbTextCompare) <> 0 Then
.OLEDBConnection.Connection = ConnectionString
End If
.Refresh
End With
End Sub
This UpdateWorkbookConnection subroutine only works on updating OLEDB or ODBC connections. The connection does not necessarily have to be linked to a pivot table. It also fixes another problem and allows you to update the connection even if there are multiple pivot tables based on the same connection.
To initiate the update just call the function with the connection object and command text parameters like this:
UpdateWorkbookConnection ActiveWorkbook.Connections("Connection"), "exec sp_MyAwesomeProcedure"
You can optionally update the connection string as well.
If you want to delete if right after refresh you should do the refresh not in the background (using first parameter -> Refresh False) so that you have proper sequence of actions
Try setting the QueryTable.MaintainConnection property to False...
"Set MaintainConnection to True if the connection to the specified data source is to be maintained after the refresh and until the workbook is closed. The default value is True! And there doesn't seem to be a UI check box for this (Read/write Boolean)"
Still relevant years later...battling the same issue and this is the most helpful thread out there. My situation is a variant of the above and I will add my solution when I find it.
I am using an Access database for my data source and establish a querytable on a new sheet. I then add two more new sheets and try to establish a querytable using the same connection on each of them, but to a different Access table. The first querytable works just fine and I use .QueryTables(1).Delete and setting the querytable object to Nothing to make it disconnected.
However, the next sheet fails on establishing a new querytable using the same connection, which was not closed. I suspect (and will add the solution below) that I need to drop the connection before deleting the querytable. Rasmus' code above looks like the likely solution.