I have a ASP classic intranet site running on Windows 2003 with IIS 6. Before you ask why its a site, I inherited the site and at present it cannot be changed. I'm trying to convert a part of site that does a look up on an old database that needs to go away to instead look up a user in AD and give permissions based on if they are a member of a security group. The code I have works using VBscript to search for the user in AD and grab their group memberships. The issue I have appears to be a double hop or permissions issue in IIS that blocks me. Here is my code:
<%
Dim sLogonUser : sLogonUser = Request.ServerVariables("Logon_User")
Dim sDomain : sDomain = Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1)
Dim sLogonName : sLogonName = Mid(sLogonUser, Instr(1, sLogonUser, "\") + 1)
response.write sDomain
response.write sLogonName
' Create ADO connection to Active Directory
'
Dim oConnection
Set oConnection = CreateObject("ADODB.Connection")
With oConnection
.Provider = "ADsDSOObject"
.Mode = "1" 'Read
.Properties("Encrypt Password") = True
.Open "Active Directory Provider"
End With
' Create command to search user in Active Directory
'
Dim oCommand
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
' Build the ADsPath element of the CommandText
'
Dim oRoot
Dim oDomain
Dim sADsPath
Dim sFilter
Dim sAttribsToReturn
Dim sDepth
Dim oRS
Dim i
Dim value
Dim c_EmployeeDirectoryConnectionString
Set oRoot = GetObject("LDAP://" & sDomain & "/rootdse")
Set oDomain = GetObject("LDAP://" & sDomain & "/" & oRoot.Get("defaultNamingContext"))
sADsPath = "<" & oDomain.ADsPath & ">"
' Build the filter element of the CommandText
'
sFilter = "(&(objectCategory=Person)(objectClass=user)(sAMAccountName=" & sLogonName & "))"
' Build the returned attributes element of the CommandText
'
sAttribsToReturn = "distinguishedName,memberOf"
' Build the depth element of the CommandText
'
sDepth = "subTree"
' Assemble the CommandText
'
ocommand.CommandText = sADsPath & ";" & sFilter & ";" & sAttribsToReturn & ";" & sDepth
' Execute the query
'
Set oRS = ocommand.Execute
' Only one user should meet the criteria
'
If (oRS.RecordCount = 1) Then
' Get that user's info
'
oRS.MoveFirst
For i = 0 To oRS.Fields.Count - 1
' memberOf
'
If (oRS.Fields(i).Name = "memberOf") Then
' adVariant
'
For Each value In oRS.Fields(i).Value
if Instr(value, "testgroup") <> 0 then
response.write "member of testgroup"
End If
Next
End If
Next
End If
%>
When you run the code you get the user correctly but when it goes to look them up to AD it fails with error: '80072020' <iis site path>/test.asp, line 44
I get the error when run both locally on the webserver or remotely from my machine. The web server is configured with integrated windows auth. Anonymous authentication is off and the site is set up with a application pool identity running as a domain service account. I don't know enough about IIS to know what the issue is but I assume I have something set up wrong. If I hard code a user name and run under anonymous authentication it will look up the user just fine. Any help or a nudge in the right direction would be awesome.
Have you tried giving IUSR_machinename and IWAM_machinename full change permissions to the relevant folders?
turned out to be a kerberos issue. The IIS site was not properly configured to use kerberos. So when a user loaded the page it would take their domain login name from windows authentication and try to pass that to AD and since all users have read rights on the domain they should be able to look up group memberships. but since it was not using kerberos it could not send the credentials to AD to do the query.
Adding SPNs for the IIS webserver and the domain account running the application pool then setting the service account to be trusted for kerberos authentication fixed the issue.
I used this thread as a reference: similar issue
And I used this tool to help me trouble shoot kerberos: Kerberos Delegation utility for IIS
Related
I have an excel file that contains a series of OLEDB connections leveraged by several pivot tables. I would like to create a VBA function that removes all password from that several connection string as the file is closed(so that the users password will not be persisted). First I thought all I need to do was set the "Save Password" property to false, something like this:
Public Sub RemovePasswordByNamePrefix()
Dim cn As Object
Dim oledbCn As OLEDBConnection
For Each cn In ThisWorkbook.connections
Set oledbCn = cn.OLEDBConnection
oledbCn.SavePassword = False
Next
End Sub
Should work right, on closing the file and reopening it you shouldn't see the password anymore in the connection string. It should not be "Saved":
Wrong, password is still there... It has been "Saved". Not sure what that feature is supposed to do. Maybe there referring to a different password? So, I attempted the big hammer approach, unfortunately it has it's own challenges, and so far I haven't gotten that working.
I'm not quite sure how to do this... Why is this so massively insecure? It persists plaintext passwords every file that contains a connection string of this sort, easily readable by whoever could access that file.
Maybe I could make some sort of Regex to remove just the password from the file? When I do that in the interface my cubes refresh and prompt me for my credentials, (I wonder)would that occur if I did it in VBA, even if the trigger is upon excels closure?
Bottom Line: What is the best way to prevent these passwords from being persisted in the file upon it's closure?
#TomJohnRiddle points out that I should look at modifying the connection string similar to the following question. Initially I was concerned that taking this approach could prompt the user with a login screen after modifying the connection string. However since I don't have any better ideas I gave it a shot, and it seems to work, here's what I've mocked up:
Public Sub RemovePasswordByNamePrefix()
Dim cn As Object
Dim oledbCn As OLEDBConnection
Dim regEx As New RegExp
regEx.Pattern = "Password=[^;]*;"
For Each cn In ThisWorkbook.connections
Set oledbCn = cn.OLEDBConnection
oledbCn.SavePassword = False
oledbCn.connection = regEx.Replace(oledbCn.connection, "")
oledbCn.CommandText = "" 'My app repopulates this after open
Next
End Sub
and it seems to work:
So I think I'll go with this approach, but I'm still open to other suggestions. Would be nice to clear everything and fully reload it, but so far that doesn't appear to be possible.
I'm also concerned with what versions of VBA support the "Regex" references. I would like something that would be Excel 2010+ 32/64 bit compatible. I have yet to test this on any older version(I'm currently running Office 365). I assume it will all work fine, but I've been unpleasantly surprised with these things in the past.
See this on SQL Server authentication Authentication in SQL Server. There it says you can use 100% Windows Authentication or you can use Mixed-Mode (Windows Authentication and passwords). If you really want to banish passwords from connection strings do not install with Mixed Mode Authentication just run 100% Windows Authentication. However, there may be some code already deployed written to use passwords so that may not always be practical.
So, the other way to discipline no passwords is to use
Integrated Security=true;
in your connection strings. This Stack Overflow question on the subject is well visited.
#NigelHeffernan suggests a slightly different approach for how to do this, here's a version without regex's:
Public Sub RemovePasswordByNamePrefix()
Dim cn As Object
Dim oledbCn As OLEDBConnection
Dim stringArray
Dim stringElement As Variant
Dim newStringArray As Variant
For Each cn In ThisWorkbook.connections
Set oledbCn = cn.OLEDBConnection
oledbCn.SavePassword = False
stringArray = Split(oledbCn.connection, ";")
For Each stringElement In stringArray
If Not InStr(stringElement, "Password=") Then
If IsEmpty(newStringArray) Then
newStringArray = Array(stringElement)
Else
ReDim Preserve newStringArray(UBound(newStringArray) + 1)
newStringArray(UBound(newStringArray)) = stringElement
End If
End If
Next
oledbCn.connection = Join(newStringArray, ";")
oledbCn.CommandText = "" 'My app repopulates this after open
Next
End Sub
I'm not sure the benefit of this method(other than a lack of another library reference) and I haven't tested outside of one connection string/one machine yet. My connection strings don't contain the "Extended Properties" field, maybe this approach wouldn't work for that.
It looks like you are using DSNs, which is something that Excel will create if you use the default connection management tools in the GUI. When working with DSNs, the ODBC driver will sometimes put cleartext passwords in to the Registry, even when you don't select "Save Password".
Instead of allowing Excel to manage your connections you would need to manage them yourself. Here is some example code from MS MVP Ben Clothier. You would have to modify the connection string to match your use case. You might be able to copy the details from your existing connections before you remove them.
Public Function InitConnect(UserName As String, Password As String) As Boolean
‘ Description: Should be called in the application’s startup
‘ to ensure that Access has a cached connection
‘ for all other ODBC objects’ use.
On Error GoTo ErrHandler
Dim dbCurrent As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
‘<configuration specific to MySQL ODBC driver>
strConnection = “ODBC;DRIVER={MySQL ODBC 5.1 Driver};” & _
“Server=” & ServerAddress & “;” & _
“Port=” & PortNum & “;” & _
“Option=” & Opt & “;” & _ ‘MySql-specific configuration
“Stmt=;” & _
“Database=” & DbName & “;”
Set dbCurrent = DBEngine(0)(0)
Set qdf = dbCurrent.CreateQueryDef(“”)
With qdf
.Connect = strConnection & _
“Uid=” & UserName & “;” & _
“Pwd=” & Password
.SQL = “SELECT CURRENT_USER();”
Set rst = .OpenRecordset(dbOpenSnapshot, dbSQLPassThrough)
End With
InitConnect = True
ExitProcedure:
On Error Resume Next
Set rst = Nothing
Set qdf = Nothing
Set dbCurrent = Nothing
Exit Function
ErrHandler:
InitConnect = False
MsgBox Err.Description & ” (” & Err.Number & “) encountered”, _
vbOKOnly + vbCritical, “InitConnect”
Resume ExitProcedure
Resume
End Function
NOTE:
This is written for MS Access, not Excel. The concepts are all the same. You might want to try making your front end in Access and then export your views to Excel from Access. This would allow you better control of the link to your back-end and allow you to use SQL in Access to define what you want to export to Excel.
READ THIS:
https://www.microsoft.com/en-us/microsoft-365/blog/2011/04/08/power-tip-improve-the-security-of-database-connections/
I have an Excel workbook that has an active data connection to a SharePoint list on a company server. The SP list is just a listing of all the files in an SP document library at that point in time. I have a VBA subroutine that is responsible for refreshing this data connection to see what is in the library at that time and then move some info from the list (document name, document author, submission timestamp, etc.) to a different workbook.
The SharePoint site uses Active Directory credentials to authenticate and the SharePoint is also mapped as a network drive on the PC running the code. But even so, refreshing this data connection sometimes results in a credential prompt that looks just like the image at the end of my post. If I manually enter the same AD credentials again, the connection request is authenticated and the list updates in Excel.
My question is this: how can I account for this in my code? Ideally, I would like for this to trigger an email alert or something, but the thing is that the line of code (ThisWorkbook.RefreshAll) that performs the connection refresh does not run to completion until the credential prompt is dealt with, so I can't set up any handlers in the lines of code that follow. I can't have this refresh potentially resulting in code that just hangs on this line until someone happens to notice something is wrong (it is running on an unattended PC). Anyone know anything that could help deal with my issue?
Since the drive is locally mapped, you should be able to just go directly to the file and manipulate it however you need, importing it, instead of having an active data connection. It would allow you more flexibility than a more rigid data connection.
This website has a good example showing how to do what you're looking for, but the way I'm imagining would be more efficient considering the circumstances.
This really depends on how you are doing your connection and in some instances it is not possible, but you can append Username and Password to a URL to pass your credentials, such as defined here (for other languages but you get the gist):
https://www.connectionstrings.com/sharepoint/
Now the reality is, you probably aren't doing a REST connection and you might have to as discussed here: https://www.experts-exchange.com/questions/28628642/Excel-VBA-code-using-authentication-to-SharePoint.html
They recommended:
Public Sub CopyToSharePoint()
On Error GoTo err_Copy
Dim xmlhttp
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Dim LlFileLength As Long
Dim Lvarbin() As Byte
Dim LobjXML As Object
Dim LstrFileName As String
Dim LvarBinData As Variant
Dim PstrFullfileName As String
Dim PstrTargetURL As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr As Folder
Dim f As File
Dim pw As String
Dim UserName As String
Dim RetVal
Dim I As Integer
Dim totFiles As Integer
Dim Start As Date, Finish As Date
UserName = InputBox(Username?") pw = InputBox("Password?")
sharepointUrl = "[http path to server]/[server folder to write to]"
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
Set fldr = fso.GetFolder(CurrentProject.Path & "\[folder with files to
upload]\") totFiles = fldr.Files.Count
For Each f In fldr.Files
sharepointFileName = sharepointUrl & f.Name
'**************************** Upload text files
**************************************************
If Not sharepointFileName Like "*.gif" And Not sharepointFileName
Like "*.xls" And Not sharepointFileName Like "*.mpp" Then
Set tsIn = f.OpenAsTextStream
sBody = tsIn.ReadAll
tsIn.Close
Set xmlhttp = CreateObject("MSXML2.XMLHTTP.4.0")
xmlhttp.Open "PUT", sharepointFileName, False, UserName, Password
xmlhttp.Send sBody
Else
'**************************** Upload binary files
**************************************************
PstrFullfileName = CurrentProject.Path & "\[folder with files to upload]\" & f.Name
LlFileLength = FileLen(PstrFullfileName) - 1
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
' Convert to variant to PUT.
LvarBinData = Lvarbin
PstrTargetURL = sharepointUrl & f.Name
' Put the data to the server, false means synchronous.
LobjXML.Open "PUT", PstrTargetURL, False, Username, Password
' Send the file in.
LobjXML.Send LvarBinData
End If
I = I + 1 RetVal = SysCmd(acSysCmdSetStatus, "File " & I & " of " & totFiles & " copied...") Next f
RetVal = SysCmd(acSysCmdClearStatus) Set LobjXML = Nothing Set
fso = Nothing
err_Copy: If Err <> 0 Then MsgBox Err & " " & Err.Description End If
End Sub
Realistically, I think this answer may get you going down the right road: https://sharepoint.stackexchange.com/questions/255264/sharepoint-api-and-vba-access-denied
Regardless, this is a problem and good luck. I had better luck using MS Access to link the list as a table and then using Excel to just call Access and get what I needed.
Private Sub cmdSyncSP_Click()
On Error GoTo ErrorCode
Application.Cursor = xlWait
Dim app As New Access.Application
'Set app = CreateObject("Application.Access")
app.OpenCurrentDatabase Application.ActiveWorkbook.Path & "\SP_Sync.accdb"
app.Visible = False
app.Run "doManualCheck"
app.CloseCurrentDatabase
Set app = Nothing
MsgBox "Sync has finished. Refresh and proceed to copy your data.", vbInformation + vbOKOnly, "Success"
ExitCode:
On Error Resume Next
Application.Cursor = xlDefault
Exit Sub
ErrorCode:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Sync Error"
Resume ExitCode
End Sub
Objective - Get SharePoint List data into Excel via Excel VBA Code specifically.
Issue - The following code loads the list values into Excel as expected, BUT i want to pass username & password manually using the same code so i can change the credentials as per the need.
Technology Used - SharePoint 2010 and Excel VBA.
Complete Code:
Sub RCAFunc()
Dim objMyList As ListObject*emphasized text*
Dim objWksheet As Worksheet
Dim strSPServer As String
Const SERVER As String = "intranet.xyz.com/Ops/RCA/"
Const LISTNAME As String = "{15f4dl02-iz9g-496o-uh9q-6br0984bb9tw}"
Const VIEWNAME As String = "294O2P46-ZC5S-4ETL-BQC9-4I234A4C4025"
' The SharePoint server URL pointing to
' the SharePoint list to import into Excel.
strSPServer = "http://" & SERVER & "/_vti_bin"
' Add a new worksheet to the active workbook.
'Set objWksheet = Worksheets.Add
Set objWksheet = Worksheets("MySheet1")
' Add a list range to the newly created worksheet
' and populated it with the data from the SharePoint list.
Set objMyList = objWksheet.ListObjects.Add(xlSrcExternal, Array(strSPServer, LISTNAME, VIEWNAME), True, , Range("a1"))
Set objMyList = Nothing
Set objWksheet = Nothing
Call MyList1
'MsgBox ("Task Completed!")
End Sub
Sub MyList1()
Dim wrksht As Worksheet
Dim objListObj As ListObject
Set wrksht = ActiveWorkbook.Worksheets("MySheet1")
Set objListObj = wrksht.ListObjects(1)
objListObj.Unlist
End Sub
Thank You!
You didn't specify why you need this, if you'd use this to distribute some data to others, then you could set the permissions on sharepoint so others can access the data as well.
If thats not possible(?) then you could use OLEDB connection to sharepoint, in which you set the user credentials.
However if this file will be distributed than storing username and password in vba plain text code, is a very very bad idea.
I found This connection string reference which suggests that you can append the username and password to the URL.
You may be also able to manually supply credentials by running Excel with the credentials, as VBA normally runs in the same context as the application.
Alternatively you could look to get the data via ADO which should allow you to set the credentials in the connection string. Here is an example
I have the following script to determine whether the current user is a part of a pre-determined group. I can get the correct username using the ADSystemInfo, but the objGroup.IsMember function always returns true. Even if there is no Group to check.
I'm using Internet Explorer 11 and the website (IIS 8.5, Windows Server 2012 R2) is set to authenticate users, ie. Anonymous Authentication is disabled.
<%
function IsAMemberOf(sGroupDN)
IsAMemberOf = "N"
on error resume next
dim objGroup, objADSysInfo, strUserDN
'https://technet.microsoft.com/en-us/library/ee198776.aspx
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objGroup = GetObject("LDAP://" & sGroupDN & ",OU=MyTown,OU=MyDomain,DC=LOCAL")
if not IsEmpty(objGroup) then
if objGroup.IsMember("LDAP://" & objADSysInfo.UserName)Then
' The user is in the group so we can do things
'response.write(Request.ServerVariables("AUTH_USER") & " is a member of " & sGroupDN & "<br>")
IsAMemberOf = "Y"
end if
end if
set objGroup = nothing
set objADSysInfo = nothing
end function
%>
What can I try next?
I have an Excel-based application that gathers some user input, and makes some calculations based on that user input. The application itself doesn't store any of the user input or calculations; currently whenever a user runs the application, it sends the data to an Access database and inserts a row into an Access table xlTable that's linked to a Sharepoint list. The relevant code is:
sub sendToSharepoint(userName as string, folderPath as string, calculatedValue as long)
dim db as DAO.database
dim insertStr as string
'open connection to Access db
set db=OpenDatabase(myDatabasePath)
'build insert string
insertStr="insert into xlTable (userName,folderPath,calculatedValue,workDate) values (""" & userName & """,""" & folderPath & """," & calculatedValue & ","#" & Now & "#)"
'insert values into xlTable, which adds them to the Sharepoint list
db.execute insertStr,dbFailonError
end sub
Because we've had some issues with Access disconnecting from Sharepoint and therefore not populating the list, and in general want to simplify our data transfer process, I'd like to send the data directly from Excel to Sharepoint without using Access. I've read some stuff on SO about using Web Services to update Sharepoint, but I haven't been able to figure out how these work exactly, or how to implement them in VBA.
What info would I need about my Sharepoint list to manipulate it from Excel VBA similar to the above code? Do I need to add any references?
You could use the Camelot .NET Connector to query SharePoint directly from VB/ASP using the COM+ component that comes with the next version (2.0). See http://bendsoft.com/net-sharepoint-connector/.
'define connection string
Dim connectionString
connectionString = "Server=mysharepointserver.com;Database=sites/test;Domain=;User=xxxx;Password=xxxx;Authentication=Ntlm;TimeOut=50;RecursiveMode=RecursiveAll;DecodeName=True;NoListFilters=False;ExpandUserFields=False;StrictMode=true;DefaultLimit=1000"
'activate connector com+
Dim connector
Set Connector = CreateObject("Camelot.SharePointConnector.Com.Connector")
' your query
Dim sql
sql = "insert into sharepointlist (userName, folderPath, calculatedValue, workDate) values ('" & userName & "', '" & folderPath & "', " & calculatedValue & ", '" & Now & "')"
' execute query
connector.ExecuteNonQuery(sql, connectionString)
All data manipulations can be done through SharePoint Lists Web service named lists.asmx. You have to call into that web sevice. For instance UpdateListItems method should do what MS Access does now.
One option you can use to access the lists web sevice, is "Microsoft SOAP Toolkit" which has to be installed as office component (never done that, but here is an article describing it: http://oreilly.com/pub/h/1306
Another option is to use MSXML library (which is always available) and sending SOAP requests as simple HTTP requests. Then parsing the results as xml. There is an article showing examples how to do it: http://blogs.msdn.com/b/jpsanders/archive/2007/06/14/how-to-send-soap-call-using-msxml-replace-stk.aspx