I'm having trouble with a odbc connection in excel-vba tool.
Public connString As Connection
Sub login()
logout
Set wrkODBC1 = CreateWorkspace("NewODBC", "admin", "", dbUseODBC)
Set connString= wrkODBC1.OpenConnection("odbc-database", dbDriverNoPrompt, , "ODBC;uid=user;pwd=passwrd;DSN=odbc-database")
End Sub
Sub logout()
On Error Resume Next
connString.Close
wrkODBC1.Close
On Error GoTo 0
End Sub
When running this code:
login
txt = "SELECT [col1],[col1] FROM database.[dbo].[table]"
sqlToWorksheet sheet, connString, txt
Sub sqlToWorksheet(sheet, conn, sqlString)
Set temp = conn.OpenRecordset(sqlString, dbOpenSnapshot)
When conn.OpenRecordset is executed I get the error: Error 3420: Object invalid or no longer set. Anyone knows what wrong? Works with my other odbc connections. The database is a mssqlserver2012.
I forgot this instantiate wrkODBC1, working now.
Related
Perform a development where it is necessary for me to obtain the mail that is registered in the Outlook session in Windows. In that sense, the only thing that the user has to do is enter their windows session password to be able to log in and then go to a SharePoint and download several files. At the time of executing the programming, it sends me the following error.
Please verify whit the support the next error: Unable to cast COM
object type 'Microsoft.Office.Interop.Outlook.ApplicationClass' to
interface type 'Microsoft.Office.Interop.Outlook._Application'. This
operation failed because the QueryInterface call on the COM component
for the interface with ID '{00063001-0000-0000-C000-000000000046}'
failed due to the following error: Error loading type library/DLL.
(Exception from HRESULT: 0x80029C4A (TYPE_E_CANTLOADLIBRARY)).
I already checked in regedit, but the subkey is at 0, I investigated this a little in other internet sites but I still have the same problem.
Can you help me to see where the error is? This is the code that I developed.
The Outlook version is 2016 (O365) and Windows 10.
Imports System.Security
Imports Microsoft.SharePoint.Client
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
Imports System.IO
Imports Microsoft.SharePoint
Imports System.Net
Imports System.Net.Http
Imports Microsoft.ProjectServer.Client
Imports System
Imports System.Management
Imports System.Text
Imports Outlook = Microsoft.Office.Interop.Outlook
Module UpdateDB
Dim password As String
Dim url As String
Dim username As String
Dim ctx As ClientContext
Dim securedPassword
Public Function updateDb(value As Integer)
Try
ActivateOL()
Dim outlook As Outlook.Application = New Outlook.Application()
Dim addrEntry As Outlook.AddressEntry = outlook.Session.CurrentUser.AddressEntry
If addrEntry.Type = "EX" Then
Dim currentUser As Outlook.ExchangeUser = outlook.Session.CurrentUser.AddressEntry.GetExchangeUser()
If currentUser IsNot Nothing Then
Dim sb As StringBuilder = New StringBuilder()
username = currentUser.PrimarySmtpAddress
End If
End If
Dim siteUrl As String = "https://name_company.sharepoint.com/sites/test/"
password = Form1.MyInputBox("Please Enter Your Password")
Form1.ProgressBar1.Minimum = 0
Form1.ProgressBar1.Maximum = 28
Form1.ProgressBar1.Visible = True
Form1.Label115.Visible = True
Form1.Label115.BringToFront()
Form1.ProgressBar1.Value = 0
url = "https://name_company.sharepoint.com/sites/test/SiteFiles/test.txt"
ctx = New ClientContext(url)
securedPassword = New SecureString()
For Each c In password.ToCharArray()
securedPassword.AppendChar(c)
Next
My.Computer.FileSystem.DeleteFile("C:\Temp\test.txt")
ctx.Credentials = New SharePointOnlineCredentials(username, securedPassword)
DownloadFile(url, ctx.Credentials, "C:\Temp\test.txt")
Form1.ProgressBar1.Value = 1
Catch ex As Exception
MsgBox("Please verify whit the support the next error: " & ex.Message, MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "TEST")
Form1.ProgressBar1.Value = 0
Form1.ProgressBar1.Visible = False
value = 1
Return value
GoTo finFunction
End Try
ctx.Credentials = New SharePointOnlineCredentials(username, securedPassword)
url = "https://name_company.sharepoint.com/sites/test/DATA%20BASE/DEVICES.xlsx"
ctx = New ClientContext(url)
ctx.Credentials = New SharePointOnlineCredentials(username, securedPassword)
DownloadFile(url, ctx.Credentials, "C:\Users\Public\Documents\TEST.xlsx")
Form1.ProgressBar1.Value = 3
MsgBox("UPDATED COMPLETED", MsgBoxStyle.Information + MessageBoxButtons.OK, "ABB - MNS PRO")
Form1.ProgressBar1.Visible = False
Form1.Label115.Visible = False
finFunction:
End Function
Sub DownloadFile(ByVal webUrl As String, ByVal credentials As ICredentials, ByVal fileRelativeUrl As String)
Using client = New WebClient()
client.Headers.Add("X-FORMS_BASED_AUTH_ACCEPTED", "f")
client.Headers.Add("User-Agent: Other")
client.Credentials = credentials
client.DownloadFile(webUrl, fileRelativeUrl)
End Using
End Sub
Sub DeleteFilesInsideFolder(ByVal target_folder_path As String)
' loop through each file in the target directory
For Each file_path As String In Directory.GetFiles(target_folder_path)
' delete the file if possible...otherwise skip it
Try
My.Computer.FileSystem.DeleteFile(file_path)
Catch ex As Exception
MessageBox.Show(ex.Message, "TEST")
End Try
Next
End Sub
<DllImport("netapi32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Unicode)>
Public Function NetUserChangePassword(
<MarshalAs(UnmanagedType.LPWStr)> ByVal OldPass As String) As Integer
End Function
Public Sub ChangePassword(ByVal oldPassword As String)
Try
NetUserChangePassword(oldPassword)
Catch ex As Exception
Throw
End Try
End Sub
Sub ActivateOL()
'Error 429 occurs with GetObject if Outlook is not running.
On Error Resume Next
Dim objOutlook = GetObject(, "Outlook.Application")
If Err.Number = 429 Then 'Outlook is NOT running.
MsgBox("Outlook is not running")
End If
End Sub
End Module
Thanks for the support.
First Update
Public Function updateDb(value As Integer)
Try
ActivateOL()
Dim outlook As Outlook.Application = Nothing
Try
outlook = DirectCast(Marshal.GetActiveObject("Outlook.Application"), Outlook.Application)
Catch
outlook = New Outlook.Application()
End Try
End Sub
Sub ActivateOL()
'Error 429 occurs with GetObject if Outlook is not running.
Dim objOutlook = GetObject(, "Outlook.Application")
If Err.Number = 429 Then 'Outlook is NOT running.
MsgBox("Outlook is not running")
End If
End Sub
It not seems a problem of your code but a problem on Windows-Outlook configuration matter.
I've solved using point 3 "Ensure MSOUTL.LIB is Registered" of this fantastic guide (the most precise and techincal that I've found after 'few' hours of search)
webmakers - Interface not registered (Exception from HRESULT: 0x80040155) – Microsoft Office/Outlook Error, after checked the previous point, obviously.
Thanks to Jatin-Auckland for a clear and step by step guide.
I have developed a small Excel addin using VBA which connects directly to a database. I set up the connection via a DSN. The addin works wonderfully when opening it and going right at it. However, after a while the connection to the database seems to timeout. More precisely, a perfectly valid query returns an error when trying to open the recordset.
My code is something like this:
'Check Connection
If Not MakeConnectionToDB Then
'Connection failed
[do something]
Exit Function
End If
'Active connection - run the query!
If Rs Is Nothing Then Set Rs = New ADODB.Recordset 'make sure its an active object
If Not Rs.State = adStateClosed Then Rs.Close 'make sure its not full (throws error if a query was called before)
Rs.Open strSQLQuery, CON 'Run query
the rs.open statement fails if the application was open but not used for a while. This is despite the MakeConnectionToDB UDF, which looks something like this:
If Not ConIsActive Then 'If there is no active connection, make it so
If CON Is Nothing Then 'Connection may be inactive because the object dropped, or because it timed out, or any other reason - Only recreate the object if the former is the case
Set CON = New ADODB.Connection
End If
On Error Resume Next
CON.Open strCon 'Try to connect - on error resume statement in order to ignore a connection error, that will be caught below
On Error GoTo 0
Err.Clear
MakeConnectionToDB = ConIsActive 'This is where a connection error will be caught if it occurred
Else
MakeConnectionToDB = True 'connection is active already
End If
and ConIsActive looks like:
Private Function ConIsActive() As Boolean
'return TRUE if there is an active connection, false otherwise
Dim blnTemp As Boolean
blnTemp = False
If (Not (CON Is Nothing)) And (Not (CON = "")) Then If CON.State = adStateOpen Then blnTemp = True
ConIsActive = blnTemp
End Function
Basically, I check if the connection is open. My problem: All these checks return TRUE, but the connection isn't open at all. If I connect, then leave the application for a while, then get back to it, all the above will return that the connection is active, but when trying to open the recordset with a new query it will fail, presumably because the server closed the connection or something. I need to find a way to check if the connection is actually able to open a recordset.
Can I ping the server or something? How can I check if the database actually returns a result to my queries? Is there a way that has a higher performance than just sending a test query to the server combined with error handling on the recordset? I suppose that would work, but I need a high performance solution and I don't think doubling the number of queries for a simple connection check is a superior solution...
Any help is appreciated!
Your CON object seems to be globally-scoped, opened once, and then used everywhere in your code, and possibly closed at some point... or not.
Like every single object in any code base written in any language that supports objects, a database connection should be as short-lived as possible.
You open it, you do what you need to do with it, and then you close it. If you don't know what the next command is going to be executed against it and when, then the connection has no business remaining open.
Delete your global-scope CON. Kill it, with fire. A connection should be local to the function or procedure that uses it - it begins in that scope, and ends in that scope.
Or you can encapsulate it in your own object, if that makes things easier for you.
'#Folder("Data.SqlConnection")
Option Explicit
Private Const CONNECTION_STRING As String = "{CONNECTION STRING}"
Private mConnection As ADODB.Connection
Private Sub Class_Initialize()
Set mConnection = New ADODB.Connection
mConnection.Open
End Sub
Private Sub Class_Terminate()
mConnection.Close
Set mConnection = Nothing
End Sub
Public Sub ExecuteNonQuery(ByVal sql As String, ParamArray params())
With New ADODB.Command
Set .ActiveConnection = mConnection
Dim p As ADODB.Parameter
For Each p In params
.Paramaters.Append p
Next
.Execute
End With
End Sub
'...
An instance of that SqlConnection class should also be as short-lived as possible, but now most of the plumbing is abstracted away so your calling code can look like this:
Const sql As String = "exec dbo.LogUserIn #userName=?, #password=?;"
With New SqlConnection
Dim userName As ADODB.Parameter
Set userName = .CreateStringParameter(Environ$("USERNAME"))
Dim password As ADODB.Parameter
Set password = .CreateStringParameter(PromptForPassword)
.ExecuteNonQuery sql, userName, password
End With
The connection begins at New SqlConnection, cleanly ends at End With, and you can tweak that SqlClass as you need, to support transactions, and/or as illustrated above, to abstract away the parameter-creating boilerplate.
But the idea remains: you don't create a database connection and leave it dangling in global scope, not knowing whether some code somewhere might have set it to Nothing, or closed it, or started a transaction that was never committed, or God knows what.
Create
Open
Execute
Close
Always. As tightly-scoped as possible. Then you won't have any object lifetime issues.
I am trying to connect to HPQC though vbscript in excel. I have already added the OTA library to Reference.
When I am trying to instantiate an object as TDConnection,
Global tdc As TDConnection
Set tdc = new TDConnection
its throwing an error:
Run-time error '429':
ActiveX component can't create object.
I used the below code to check:
Sub Connect()
Dim tdc as TDConnection
Dim url as String
Dim Domain as String
Dim Project as String
Dim username as String
Dim Password as String
url = "http://qc.abcdef.com"
Domain = "NNNN"
Project = "NNNNNNN"
username = "ABCD"
Pasword = "XYZ"
Disconnect 'Disconnects any open connections
If (tdc Is Nothing) Then Set tdc = New TDConnection
If (tdc Is Nothing) Then GoTo ConnectionErr
tdc.InitConnectionEx url 'Initiate Connection
tdc.Login username, Password
tdc.Connect Domain, Project
MsgBox "Connection Established"
Exit Sub
ConnectionErr:
MsgBox "Connection Error"
End Sub
Then ran from cmd the below command
C:\Windows\SysWOW64> wscript.exe "C:\...\QC.vbs"
but facing error
Please help!
Try running your VB script with command prompt using specific cscript -
C:\WINDOWS\SysWOW64>cscript.exe ".... .vbs"
For more info refer https://community.hpe.com/t5/Quality-Center-ALM-Practitioners/ActiveX-component-can-t-create-object-TDApiOle80-TDConnection/td-p/4742677
When an sql query makes a call to a vba function and that function raises an error, the error handling code fails to handle the error.
See example below. The call to GetId() in the strSql generates an error when the Set rst = db.OpenRecordset(strSql) is executed.
This error is not handled by the On Error GoTo Err_Test error handler!
Public Function GetId() As Long
Err.Raise 11 'Divide by zero error
End Function
Public Function Test() As String
On Error GoTo Err_Test
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSql As String
Set db = CurrentDb()
strSql = "Select * FROM MyTable WHERE MyTable.Id = GetId()"
Set rst = db.OpenRecordset(strSql)
Test = rst!name
Exit_Test:
If Not rst Is Nothing Then
rst.Close
Set rst = Nothing
End If
Set db = Nothing
Exit Function
Err_Test:
MsgBox Error$
Resume Exit_Test
End Function
Why does the error escape the error handler and is there some way to handle it gracefully when the sql makes a call to a vba function that generates an exception?
I know that removing the function call from the sql string as shown below, will enable the error handler to trap the error.
Dim id as Long
id = GetId()
strSql = "Select * FROM MyTable WHERE MyTable.Id = " & id
Is this the only way? If so, should one avoid using function calls in sql query strings to avoid unhandled exceptions?
My take on the observed behavior is this:
When you run "Select * FROM MyTable WHERE MyTable.Id = GetId()", GetId() is evaluated by the query engine, not by Test(), so the error handler in Test() cannot catch the runtime error. It's the same as if you would put the SQL into a query and run that.
When you do "Select * FROM MyTable WHERE MyTable.Id = " & GetId(), GetId() is evaluated by Test().
This would be the "normal" way to run your example (open a recordset in a VBA function), IMO.
But you can also use VBA functions like GetId() in queries. You only need to make sure that either the function is simple enough that it can't trigger a runtime error, or that the function has its own error handler.
If the function is run only once (in the WHERE clause), a MsgBox is acceptable as error handler. If the function is run for every row (i.e. it's in the SELECT clause), this can make for a truly horrible user experience. :p
So make sure that in this case the function returns an error code or NULL or whatever is applicable, like vacip wrote.
I am calling a vb.net function of a dll from below VBA code in MDB.
I am calling Get_GDW_data_final sub from immediate Window.
Public Sub Get_GDW_data_final()
Dim r As New Get_GDW_Data.GDW
MsgBox r.DetailedWork()
End Sub
I have created Get_GDW_Data.dll added reference of it in MDB.
The coding of class is as below.
Public Class GDW
Public Function DetailedWork()
Dim lastrow As Long
Dim ADODBcnn As New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Access8\W156_RocketOffset_Backup.mdb;Persist Security Info=False;Mode=read")
Dim ADODBcmd As New OleDb.OleDbCommand
Dim ADODBcmd1 As New OleDb.OleDbCommand
Dim ADODBrst As OleDb.OleDbDataReader
ADODBcnn.Open()
ADODBcmd.CommandText = "select count(*) from input"
lastrow = ADODBcmd.ExecuteScalar()
ADODBcnn.Close()
Return lastrow.ToString()
End Function
End Class
Here I am getting error
Run-time Error -2147467259 (80004005)
The database has been put in a state by admin or machine 'Rachit' that prvents it from being opened or locked.
I discovered what the problem was:
It's a Limitation of Access that you can not access a table of a database using a dll from which you are calling the function :-)
INPUT is a reserved word, so try:
ADODBcmd.CommandText = "select count(*) from [input]"