Excel VB Database connection test - vb.net

I have an excel spreadsheet with a bit of VB code that copies the data across to a access database. This copies the data from one sheet to a cache sheet and then from the cache sheet to the db using a flag to identify new data, This works ok but we would like to add a connection test to check if the connection to the database is ok.
This is the code i have below for the connection test:
Dim cnn As ADODB.Connection
Dim canConnect As Boolean
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=\\G-FILE1\Common_Files\All Users\Robert T\Cash Sheets\CashSheets.mdb;"
If cnn.State = adStateOpen Then
canConnect = True
cnn.Close
MsgBox "Connection UP", vbOKOnly
Else
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=\\G-FILE1\Common_File\All Users\Robert T\Cash Sheets\CashSheets.mdb;"
cnn.Close
If cnn.State = adStateClosed Then
canConnect = False
cnn.Close
MsgBox "Connection DOWN!", vbOKOnly
End If
End If
So what I want to do is this:
When button clicked > data is sent to cache sheet (Working) > Test DB connection > If not available, then msgbox user informing them > carry on caching sheet
I dont want the error window to appear, rather a msgbox and let the rest of the code carry on..
Hope this edit is a bit clearer..
Regards

It is enough if the file is available:
If Dir(accessFilePath) = "" Then
'file not found!
else
'file found!
end if

Related

VBA Form Connection Validation

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"

Excel VBA ADO SQL connection error - Could not find the object

I got a brilliant answer to my previous question from #Ryan Wildry but I thought I'd ask a different question regarding the same code: here goes.
Background Info
I have a shared (network/server) Excel template file which is both the input file and the data source (although on different sheets). Let's call that Input.xltm.
The code basically picks up a input in a range on Input Sheet, takes the first two letters and finds the closest code from Code Sheet, then populates a UserForm ListBox with the top five results.
The problem
The problem comes when users set off the UserForm and the error usually returns:
Run-time error '-2147467259'
The Microsoft Access database engine could not find the object 'C:\Users\user.name\Documents\Input1'. Make sure the object exists and that you spell its name and the path name correctly.......etc
I think it may have something to do with the fact Excel puts a number after the filename because it's a template file although I don't actually know!
The code
And here's the code:
Public MyConnection As New ADODB.Connection
Public MyRecordset As New ADODB.Recordset
Private Sub UserForm_Initialize()
Dim ColumnName As String: ColumnName = "[Variant code]"
Dim SearchStr As String: SearchStr = Left(Sheets("Input Sheet").Range("B4").Value2, 2)
Dim dbstring As String
dbstring = ThisWorkbook.FullName
Application.ScreenUpdating = False
If MyConnection.State <> adStateOpen Then
With MyConnection
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbstring & _
";Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=1';"
.Open
End With
End If
If MyRecordset.State = adStateOpen Then MyRecordset.Close
MyRecordset.Open "Select top 5 " & ColumnName & " from [Code Sheet$] where " & ColumnName & _
" like '%" & SearchStr & "%'", MyConnection, adOpenForwardOnly, adLockReadOnly
Me.ListBox1.Clear
If Not MyRecordset.EOF Then MyRecordset.MoveFirst
Application.ScreenUpdating = True
Do Until MyRecordset.EOF
Me.ListBox1.AddItem MyRecordset.Fields(0).Value
MyRecordset.MoveNext
Loop
End Sub
I just need everyone who accesses the file through the server to be able to pick up the correct data source (which is only in the next sheet) and populate the ListBox.
I'd be thankful for any suggestions! Thanks
#UPDATE
I have checked, now if you open (and then save) the actual template file so there's no '1' after the file name, then the code works as expected. It's only when the template is opened normally and the number automatically appended that it stops working.
It seems that you do not make early-binding for MyConnection and MyRecordset first.
You can make a late-binding by
step 1.
Change
Public MyConnection As New ADODB.Connection
Public MyRecordset As New ADODB.Recordset
to
Public MyConnection As object
Public MyRecordset As object
.
step 2.
Add
Set MyConnection = createobject("adodb.connection")
Set MyRecordset = createobject("adodb.recordset")
before If MyConnection.State <> adStateOpen Then

I am trying to convert an app from 2003 VB to 2010

I opened the older app in VS 2010 and made changes based on the recommendations in the error statements that popped up. However one part that is still not working is shown below.
The error that comes back is
"file is already opened exclusively by another user or you need permission to view it"
I am opening up an access database and " select" and put it in an excel worksheet. The name of the worksheet changes every time the app is used.
This worked in 2003 but not in 2010. I have goggled this and none of the answers have worked.
Dim AccessConn8 As New System.Data.OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\UpdateExportFile\ExportFile.mdb")
AccessConn8.Open()
Dim AccessCommand8 As New System.Data.OleDb.OleDbCommand("SELECT * INTO [Excel " & _
"5.0;DATABASE=c:\" & strfilename & ".xls;HDR=YES;].[sheet1] from ExcelExport", AccessConn8) '
Try
AccessCommand8.ExecuteNonQuery()
Catch exe As DataException
Catch exc As System.Exception
MsgBox("EXCEL not updated. Contact your System Administrator. " & strfilename)
MsgBox(" ----> " & exc.Message)
AccessConn8.Close() ' added sat 2/23/15
Exit Sub
End Try
AccessConn8.Close()
Dim obook As Microsoft.Office.Interop.Excel.Workbook
Dim oexcel As Microsoft.Office.Interop.Excel.Application
oexcel = CType(CreateObject("Microsoft.Office.Interop.Excel.Application"), Microsoft.Office.Interop.Excel.Application)
obook = oexcel.Workbooks.Open("c:\" & strFileName & ".xls")
Try
With oexcel
.Visible = False
.Range("C1").Value = "'Store #"
.Range("D1").Value = "'Vendor #"
End With
Catch ex As Exception
MsgBox("error:" & ex.ToString, MsgBoxStyle.Critical, "ERROR")
End Try
' added
Dim myrange As Excel.Range
myrange = oexcel.Range("a1:l90")
myrange.Sort(Key1:=myrange.Range("c1"), Order1:=Excel.XlSortOrder.xlAscending, Header:=Microsoft.Office.Interop.Excel.XlYesNoGuess.xlYes, Orientation:=Excel.XlSortOrientation.xlSortColumns)
obook.Save()
obook.Close()
oexcel.Quit()
Can you help me downed the right path to an answer?
I cannot be sure but I suspect that this behavior is caused by connection pooling that keeps the connection (and perhaps the file) open also after you have tried to close it.
I suggest two changes to your code above, all around the connectionstring and the way in which you open close the connection
Using AccessConn8 As New OleDbConnection("...;OLE DB Services = -2;")
AccessConn8.Open
......
' Code as above....
......
End Using
The OLE DB Services = -2 disables the automatic use of Connection Pooling for this connection, while the Using Statement ensures that the connection is closed and DISPOSED after you have finished to use it

Else Portion of Code keeps timing out

I have a code to check the connection between access and sql server upon opening the form. If there is a connection a message box pops up and says so. If not there is supposed to be a message box indicating there is no connection. Instead I get the error:
Run Time Error '-2147467259 (80004005)':
[DBNETLIB][ConnectionOpen (Connect()).]Specified SQL Server Not Found
Which is not what I am wanting it to do, is it something in my coding or is there no way to get this to work?
Public Sub AutoExec()
Dim cnn As ADODB.Connection
Dim localrst As New ADODB.Recordset
Dim remoterst As New ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "Provider=SQLOLEDB; Data Source=DB; Initial Catalog=HRLearnDev;" _
& "User Id=ID; Password=PW;"
If cnn.State = adStateOpen Then
MsgBox ("You have an established connection with the L&TD SQL Server Database.")
Else
MsgBox ("Cannot connect to remote server. Data will be stored locally to CDData Table until application is opened again.")
End If
cnn.Close
End Sub
In situations like these, you typically want to use an On Error GoTo construct - then send the code to your error handler if an error occurs (you can test to make sure the error number is what you expect with Err.Num).
However, in your case it may be even easier to use On Error Resume Next. This tells the interpreter "If an error occurs, go to the next line. I will figure out what went wrong and deal with it."
You usually do this when you have a single function call that either produces an error or a sensible value. I often do something like this:
On Error Resume Next
returnValue = -1
returnValue = functionThatReturnsPositiveValue()
If returnValue < 0 Then
MsgBox "oops - the function failed!"
Else
' <<<< do whatever needs doing >>>>
End If
In your case that's almost exactly what you would do. Complete example:
Public Sub AutoExec()
Dim cnn As ADODB.Connection
Dim localrst As New ADODB.Recordset
Dim remoterst As New ADODB.Recordset
On Error Resume Next ' <<<<<< add this line so an error doesn't stop the code
Set cnn = New ADODB.Connection
cnn.State = 0 ' <<<<< not sure if you need something like this, or if the New command
already set it to some sensible value other than "adStateOpen"
cnn.Open "Provider=SQLOLEDB; Data Source=DB; Initial Catalog=HRLearnDev;" _
& "User Id=ID; Password=PW;"
If cnn.State = adStateOpen Then ' <<<<<< this will only be true if no error occurred
MsgBox ("You have an established connection with the L&TD SQL Server Database.")
Else
MsgBox ("Cannot connect to remote server. Data will be stored locally to CDData Table until application is opened again.")
End If
On Error GoTo 0 ' <<<<<<<< turn off error handling - we have passed the "tricky" spot.
' <<<<<< lots more code goes here >>>>>>
If cnn.State = adStateOpen Then cnn.Close ' <<<<<<<< only close connection if it was open!!
End Sub

Query regarding dsn string

Below is the code to fill a list box in a VBA application :
Private Sub Form_Open(Cancel As Integer)
''#Populate list box control.
Dim cnn As ADODB.Connection
Dim strSQL As String
Dim rst As ADODB.Recordset
Dim strList As String
On Error GoTo ErrHandler
''#Use DSN to Northwind.
''#Modify connection and connection string as needed.
Set cnn = New ADODB.Connection
cnn.Open "DSN=NorthwindExample"
strSQL = "SELECT * FROM Shippers"
Set rst = New ADODB.Recordset
rst.Open strSQL, cnn
strList = rst.GetString(adClipString, , ";", ",")
Debug.Print strList
Me.lstShippers.RowSource = strList
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
ErrHandler:
MsgBox Err.No & ": " & Err.Description, vbOKOnly, "Error"
Set rst = Nothing
Set cnn = Nothing
End Sub
I need to know what i need to put as DSN string? Where will I get the info?
What is adClipString here in this code?
Is there any option to populate list control without using DSN connection object since I am taking the values from the same access table?
Here is a link that contains the different connection strings for Access:
http://www.connectionstrings.com/access
Something like this should work: Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mydatabase.mdb;User Id=admin;Password=;
Im not sure what adClipString is, it could be an undeclared variable or database column?
Matt
Here is the info on adClipString.
Basically, GetString method gets the content of the entire recordset into a string variable where columns will be separated by ";" and rows will be separated by "," (as per your code).
Regarding DSN - see Start -> Settings -> Control Panel -> Administrative Tools -> Data Sources (ODBC). One of the tab (I guess System DSN) is where ODBC based data source can be created and are listed.