I have an access form that pulls together data from different tables. Some of them require a username and password be entered. This is going out to other users and I would rather them not have to enter the information over and over. Is there a code that I can use that whenever it prompts for a password to have it automatically logged in?
Currently I already have a connection for one DB connection that runs whenever the DB is opened. It looks like:
Public Function StartUp()
Dim cnn As ADODB.Connection
Dim localrst As New ADODB.Recordset
Dim remoterst As New ADODB.Recordset
On Error Resume Next
Set cnn = New ADODB.Connection
cnn.Open "Provider=SQLOLEDB; Data Source=SOURCE; Initial Catalog=NAME;" _
& "User Id=ID; Password=PW;"
If cnn.State = adStateOpen Then
MsgBox ("You have an established connection with the L&TD SQL Server Database and the CDData table has been uploaded to the server.")
Else
MsgBox ("Cannot connect to SQL Server. Data will be stored locally to CDData Table until application is opened again with an established connection.")
End If
On Error GoTo 0
End Function
Is there a way to add more connections to this so it connects to all 3?
The literal answer is; no. You can't make a password form autofill. However, you can set up your connection string so that no one has to fill it in.
'Set up the connection string
strConn = "PROVIDER=SQLOLEDB;DATA SOURCE=MyServerName;INITIAL CATALOG=MyDatabaseName;UID=MyStandardUserID;PWD=MyStandardPassword;"
cnComments.Open strConn
You can also set it up without the username and password:
'Set up the connection string
strConn = "PROVIDER=SQLOLEDB;DATA SOURCE=MyServerName;INITIAL CATALOG=MyDatabaseName;TRUSTED_CONNECTION=yes;"
cnComments.Open strConn
Related
I have a VBA form that opens upon opening excel which requires user login credentials and checks if it connects to the teradata database.
Private Sub cmdLogin_Click()
Dim Cn As ADODB.Connection
Dim Rc As ADODB.Recordset
Set Cn = New ADODB.Connection
Dim user As String
Dim password As String
Dim sConnect As String
user = Me.txtUserID.Value
password = Me.txtPassword.Value
sConnect = "Driver={Teradata};DBCname=TDPREP01;DatabaseName=DBADMIN ;Uid=" & user & ";Pwd=" & password & "; Authentication=LDAP;"
Cn.Open sConnect
If Cn.State = 1 Then
Unload Me
Application.Visible = True
Worksheets("do not open!").Cells(1, 1) = user
Worksheets("do not open!").Cells(2, 1) = password
Else
MsgBox "Invalid login credentials. Please Try again.", vbOKOnly + vbCritical, "Invalid Login Details"
End If
End Sub
If details are correct then I store the login details(To use later one for other modules).
The issue that I'm encountering is if the user inserts a wrong login...then I get an error message and my app crashes with the following error:
Obviously this is due to the app crashing upon the Cn.Open sConnect
Is there a way to check if the connection is valid with an if statement?
I tried something like If Cn.Open sConnect = True Then but that doesn't work.
Could anyone advise how I could apply the If statement to check if the connection is valid?
on error goto notgood
Cn.Open sConnect
<...>
notgood:
MsgBox "Error connecting to Teradata"
Hi I am working in a excel file with 46 pivot tables. The code below changes the connection of each pivot table to a new existing connection.
Sub changeConnection()
Dim pTable As Variant
Dim sheet As Variant
Dim workBookName As String
workBookName = "filename.xlsm"
For Each sheet In Workbooks(workBookName).Worksheets
For Each pTable In sheet.PivotTables
pTable.changeConnection Workbooks(workBookName ).Connections("connection name")
Next pTable
Next sheet
End Sub
I want everything to stay the same for my pivot tables but I want a password on the file that I am connected to. Since excel can not do this I used ADO to access a password protected excel file.
Public Function readFile()
Dim xl As Object
Dim conn As New ADODB.connection
Dim recSet As ADODB.Recordset
Dim conString As String
Dim wkbName As String
Dim SQL As String
Dim DBPath As String
'Path to excel file
DBPath = "path\to\file.xlsm"
Set xl = GetObject(DBPath)
'Name of table
wkbName = "[IS$]"
conString = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
'Query
SQL = "select * from " & wkbName
'Open connection
conn.Open conString
'Itterate over record set
Set recSet = New ADODB.Recordset
recSet.Open SQL, conn
'Print out col1 from table
Do Until recSet.EOF
'process your data here
Debug.Print recSet!ISData
recSet.MoveNext
Loop
End Function
The code above will access a table inside of the password protected workbook stored externally. Then using a record set print out in debug all the items.
I want to essentially use my workaround in the second snippet of code so I can replace all my pivot table connections so my data source can have a password on it. All my pivot tables point to the same connection so using the same connection won't cause issues.
Thank in advance and please comment if I should clarify anything.
IIR there isn't a data provider that can do this. That driver will give an error to the effect of “could not decrypt file” even if you attempt to store the password in the connection string.
The second bit of code is basically a hack to get around this and it relies on Excel to manage the credential prompt from the user. It does not solve the fact that you can't supply a password in your connection string - it is a work-around. Given that you can't supply a connection string that works to ADO, you're not going to be able to supply it to the stored connection string either.
I would suggest using an actual database for the back end instead of an Excel file. This will give you much more flexibility in managing user access.
I have an Excel based application reliant on several different databases which I connect to using ADO (Microsoft ActiveX Data Objects 6.1 Library). The databases reside on regional servers and there is an overhead in establishing the initial connection so I cache the connections in a Scripting.Dictionary object for reuse.
Private moConnCacheDict As Scripting.Dictionary
When I use the kdb+ qodbc.dll database drivers I get unexpected behavior. I can connect and reuse multiple data sources (Oracle,Sybase,Access) and one KDB database instance as expected. However, if I create a second KDB database connection and execute a query on the new dataset, no data is returned despite the fact the query is legitimate.
Recordset.BOF = TRUE and Recordset.EOF = TRUE
It appears to execute fine and the fields are visible. The connection to the previous regional server seems to persist and I can successfully retrieve data which resides on the original server despite the fact that if I look at,
Recordset.ActiveCommand.ActiveConnection.Properties.Item("Extended Properties")
, is the new connection string.
The KDB+ connection string uses the following syntax:
DRIVER=kdb+;DBQ=XXXXX;UID=XXXXX;PWD=XXXXX;
I have included the core VBA functions used as an example:
Private Function ExecuteQuery(sDBName As String, ByRef oRst As ADODB.Recordset, Optional bDeleteConnection As Boolean) As Boolean
Dim oDBConn As ADODB.Connection
Dim sSql As String
'delete connection
If bDeleteConnection Then Call DropConnection(sDBName)
'get cached or new connection
Call GetConnection(sDBName, oDBConn)
Select Case sDBName
Case "MAIN_US"
sSql = mSQL_MAIN
Case "MD_ASIA"
sSql = mSQL_MDASIA
End Select
Set oRst = New Recordset
oRst.Open sSql, oDBConn, adOpenKeyset, adLockPessimistic
If Not oDBConn.State = adStateOpen Then Err.Raise vbObjectError + 1024, "ExecuteQuery", sDBName & ": Recordset Closed. Unable to execute query ->" & sSql
ExecuteQuery = True
End Function
Private Function GetConnection(sDBName As String, ByRef oDBConn As ADODB.Connection) As Boolean
If moConnCacheDict Is Nothing Then Set moConnCacheDict = New Dictionary
If moConnCacheDict.Exists(sDBName) Then
'get existing connection
Set oDBConn = moConnCacheDict.Item(sDBName)
Else
'create connection
Set oDBConn = New Connection
With oDBConn
.Mode = adModeRead
Select Case sDBName
Case "MAIN_US"
.Mode = adModeReadWrite
.ConnectionString = mCONN_MAIN
Case "MD_ASIA"
.Mode = adModeRead
.ConnectionString = mCONN_MDASIA
End Select
.CursorLocation = adUseServer
.Open
End With
moConnCacheDict.Add sDBName, oDBConn
End If
GetConnection = True
End Function
Private Function DropConnection(Optional sDBName As String) As Boolean
Dim oDBConn As ADODB.Connection
Dim i As Integer
'delete object directly from cache
If Not moConnCacheDict Is Nothing Then
If sDBName = vbNullString Then
'close all connections
For i = 0 To moConnCacheDict.Count - 1
If Not IsEmpty(moConnCacheDict.Items(i)) Then
Set oDBConn = moConnCacheDict.Items(i)
If Not oDBConn Is Nothing Then
If oDBConn.State = adStateOpen Then oDBConn.Close
Set oDBConn = Nothing
Debug.Print Now, "Dropping Database Connection - " & moConnCacheDict.Keys(i)
End If
End If
Next i
Set moConnCacheDict = Nothing
Else
If moConnCacheDict.Exists(sDBName) Then
If Not IsEmpty(moConnCacheDict.Item(sDBName)) Then
Set oDBConn = moConnCacheDict.Item(sDBName)
If Not oDBConn Is Nothing Then
If oDBConn.State = adStateOpen Then oDBConn.Close
Set oDBConn = Nothing
Debug.Print Now, "Dropping Database Connection - " & "Dropping Database Connection - " & sDBName
End If
End If
moConnCacheDict.Remove (sDBName)
End If
End If
End If
DropConnection = True
End Function
(Note the ADO.Recordset is always closed and set to nothing by the caller).
The only way to resolve the issue is to close all database connections (regardless of the provider) and then reconnect to the desired regional server. This is horrendously inefficient as I have to reopen all the existing connections. Also note that it is not sufficient to do this purely in the current workbook. This must be done at the application level. If ANY ADO connections to ANY database are still open, I can create a new KDB+ ADO Connection but it will still point to the previous instance.
I have looked at the error properties of the KDB+ connection object and there are two errors:
Multiple-step OLE DB operation generated errors. Check each OLE DB status value, if available. No work was done.
Provider does not support the property.
This appears to be documented in http://support.microsoft.com/kb/269495 but I am unable to locate any CLSID in the registry so am unable to experiment with the suggested change.
If I turn on ODBC logging I see the following message:
EXCEL 8dc-22d0 EXIT SQLGetInfoW with return code -1 (SQL_ERROR)
HDBC 0x02131EA8
UWORD 151 <SQL_KEYSET_CURSOR_ATTRIBUTES2>
PTR 0x003C4FB0
SWORD 4
SWORD * 0x00000000
DIAG [S1096] [Microsoft][ODBC Driver Manager] Information type out of range (0)
Would this be responsible for the error anyway?
As always, any help and suggestions would be much appreciated.
What you're seeing is a bug in the driver, and you should look for more recent drivers.
I shouldn't really give a full answer (instead of a comment) if I haven't run and tested the code myself, but I would recommend that you enumerate the properties collection of the connection object and look for connection pooling.
Setting connection pooling to 0 (or to false, depending on what you can guess from viewing the vartype of the property's value) is a promising workaround. Your other option is to use a forward-only recordset: that may or not work, but its worth trying.
NB: There was an open-source project a couple of years ago to write a proper OLEDB drive, but that seems to have faded from view.
I have been tasked w/ supporting an old VB6 app. (yay me) I am having trouble with the ADO connection timeout property. The method below works fine if the server exists, but if the server does not exist or network connections havent started up for the machine it will take a full 30 seconds to timeout even with the intTimeout set to 1.
Is there a way for ADO to fail to connect sooner?
Is this even possible?
Thanks!
Public Sub GetConnectionObject(ByRef oCn As ADODB.Connection, strServer As String, strInitialCatalog As String, Optional intTimeout = 10)
Dim strConnectionString As String
strConnectionString = "Data Source=[SERVER];Provider=SQLOLEDB.1;User ID=ScanReq1;Password=ScanR3Q;Initial Catalog=[INITIALCATALOG];ConnectionTimeout=" & intTimeout & ";"
strConnectionString = Replace(strConnectionString, "[SERVER]", strServer)
strConnectionString = Replace(strConnectionString, "[INITIALCATALOG]", strInitialCatalog)
Set oCn = New ADODB.Connection
oCn.CursorLocation = adUseClient
oCn.ConnectionString = strConnectionString
oCn.CommandTimeout = intTimeout
oCn.ConnectionTimeout = intTimeout
oCn.Open
End Sub
The ConnectionTimeout kicks in after the TCP connection is made. If the server can't be found, this value is controlled by the Windows TCP subsystem.
If this really is an issue for you, I'd try to ping the box first (there are plenty examples of pinging via VB6 on the net).
I've also hit this one. An alternative to setting ConnectionTimeout could be to make the Open call asynchronous, then handle the timeout in your own code. Quick and dirty example below (note: this is in VBA, but should be easily ported to VB6):
Dim conn As New ADODB.Connection
Dim time As Single, timeOut As Single
conn.ConnectionString = "your connection string here"
conn.Open Options:=adAsyncConnect ' value is 16
timeOut = 5
time = Timer()
Do Until Timer() - time > timeOut Or conn.State = adStateOpen
DoEvents
Loop
If conn.State <> adStateOpen Then 'value is 1
'timed out
Else
'successful
End If
To do it "properly", there is a ConnectionComplete event which you could handle.
I'm trying to connect to a database and keep the connection open for any amount of user activity/queries within the database. Currently I have a connection that opens and closes for any query (save, update, etc...) which requires the logon process to the back-end every time the user saves etc... Is there a way to simply connect and leave the connection open so there won't be a lag time when running the query due to the logon process? This is what I'm using:
Private sConStrFormat As String = "Provider=TDOLEDB;Data Source=TDDEV;Persist Security Info=True;User ID={0};Password={1};Default Database=bcpm_ddbo;Session Mode=ANSI;"
Private Sub cmdsave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdsave.Click
Dim sSQL As String
Dim sConStr As String
Dim user As String
Dim pass As String
user = txtuser.Text
pass = txtpass.Text
Dim UserName As String = user
Dim Password As String = pass
sConStr = String.Format(sConStrFormat, UserName, Password)
Using Con As System.Data.OleDb.OleDbConnection = New System.Data.OleDb.OleDbConnection(sConStr)
Con.Open()
sSQL = "INSERT INTO LTC_FBS (CLM_NUM) VALUES ('" & Me.txtClaim.Text & "')"
Dim cmdins As New System.Data.OleDb.OleDbCommand(sSQL, Con)
cmdins.ExecuteNonQuery()
Con.Close()
End Using
End Sub
.Net automatically maintains a connection pool for you. According to MSDN, when you call Close() on the Connection the framework
releases the connection to the
connection pool, or closes the
connection if connection pooling is
disabled
In vb.net 4.5 do the following:
At the top straight after the class definer put in this line:
Public Shared conn As OdbcConnection
Then, in the subs where you want to use the connection use this line:
If conn Is Nothing Then conn = New OdbcConnection(<your_connection_string>): conn.Open()
Then the New OdbcCommand will use the existing connection without opening a new one. Don't close the connection in your script until you are quite certain you're finished with it (_Shutdown is a good spot and you're good to go.
This also solves problems with MySQL when constantly opening new connections causes the max connections error.
Instead of defining 'con' in the using statement, define it up above as a static variable. When the function is called, you can see if 'Con' has been assined or not. If not, you build your connection string and set Con = New OleDBConnection, and open it. Since it's a static variable, it will retain its value at the next call. Check that it's not nothing, and then use it right away. Make sure you don't call close in the routine or the connection will not remain open.