alter odbc backend (1 Viewer)

[mikeo1313]

I searched through a few posts here and on the internet to get together code that you can use to alter a backend ODBC with VBA. If you have anything to add, please post.


#1. Adding Columns DAO

For DAO, addition of columns works something like:

Dim db as DAO.Database
Dim tDef as DAO.TableDef
Set db=OpenDatabase(strDbName)
Set tDef=db.TableDefs(strTableName)
With tDef
.Fields.Append .CreateField(strFieldName, [dbDouble/dbLong/etc])
End With
Set tDef=Nothing
Set db=Nothing






#2. Get name of linked DB DAO

Public Function GetLinkedDBName(TableName As String)
Dim db As DAO.Database, Ret
On Error GoTo DBNameErr
Set db = CurrentDb()
Ret = db.TableDefs(TableName).Connect
GetLinkedDBName = Right(Ret, Len(Ret) - (InStr(1, Ret, "DATABASE=") + 8))
Exit Function
DBNameErr:
GetLinkedDBName = 0
End Function


#3. Relink tables ?

Public Sub reLink(strFileName As String)
Dim db As Database
Dim tDef As TableDef
Dim tDefs As TableDefs
Set db = CurrentDb
Set tDefs = db.TableDefs

For Each tDef In tDefs
If tDef.SourceTableName <> "" Then 'If the table source is other than a base table
tDef.Connect = ";DATABASE=" & strFileName 'Set the new source
tDef.RefreshLink 'Refresh the link
End If
Next 'Goto next table
End Sub



#4. Rename Cols ADOX

Public Function RenameColumn(ByVal StrgDB_Name As String, StrgTableName As String, _
StrgOldColumnName As String, StrgNewColumnName As String) As Boolean
On Error GoTo Err_RenameColumn

'Create a Catalog object
Dim Cat As ADOX.Catalog
Set Cat = New ADOX.Catalog
Cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & StrgDB_Name

'Create a table object
Dim Tbl As ADOX.Table
Set Tbl = New ADOX.Table
Set Tbl = Cat.Tables(StrgTableName)
Tbl.Columns(StrgOldColumnName).Name = StrgNewColumnName

'Return that the function was Successfull.
RenameColumn = True

Exit_RenameColumn:
'Clean up
Set Cat = Nothing
Set Tbl = Nothing
Exit Function

Err_RenameColumn:
MsgBox "There was an Error while Renaming the Table Column [" & StrgOldColumnName & "] to [" & _
StrgNewColumnName & "] within the Table named [" & StrgTableName & "] which is located in the " & _
StrgDB_Name & " Database.", vbCritical, "Column Rename Error"
GoTo Exit_RenameColumn
End Function



#5. Open Connection ADODB

Option Compare Database
Option Explicit

Public gcnn As ADODB.Connection
Public Const LUT_PROVIDER As String = "SQLOLEDB.1"
'Public Const LUT_PROVIDER As String = "MSDASQL"
Public Const LUT_DATA_SOURCE As String = ""
Public Const LUT_INITIAL_CATALOG As String = ""
Public Const LUT_USER_ID As String = "" 'username
Public Const LUT_PASSWORD As String = "" Password



Public Function OpenConnection() As Boolean


'This is for the opening of a global ADO connection

On Error GoTo HandleError

Dim boolState As Boolean
Dim bln_error As Boolean
Dim Response As String



If gcnn Is Nothing Then
Set gcnn = New ADODB.Connection
End If

If gcnn.State = adStateOpen Then
boolState = True
Else

gcnn.ConnectionString = "Driver={SQL SERVER};Server=" & LUT_DATA_SOURCE & ";" & _
"Database=" & LUT_INITIAL_CATALOG & ";UID=" & LUT_USER_ID & ";PWD=" & LUT_PASSWORD & "

'set up errors
On Error Resume Next


'open the connection with the standard 15second timeout
gcnn.Open

'if there is no connection then this will be the error number
If Err.Number = -2147467259 Then

Err.Clear

'here deal with timeout eg ask if they want to continue
'I had to delete my stuff here that would not work for you.

IF "YES" then


gcnn.ConnectionTimeout = 20 'change to 20 seconds
gcnn.Open

'second attempt also failed so close
If Err.Number = -2147467259 Then


Application.Quit
End If


'user does not want to try again so exit application
Else
' MsgBox ProfileGetItem(strlanguage, "gcnn_err_F", sDefValue, sInifile) & vbNewLine & vbNewLine & _
' ProfileGetItem(strlanguage, "gcnn_err_G", sDefValue, sInifile), vbInformation, "No Siemens Server"
' Application.Quit
End If

Else
'if it is not a network problem then call a general error
GoTo HandleError
End If

If bln_error Then
'waiting_form_text False
'waiting_form False
DoEvents
DoEvents
bln_error = False
End If


If gcnn.State = adStateOpen Then
boolState = True
End If
End If



OpenConnection = boolState

ExitHere:
Exit Function
HandleError:
OpenConnection = False
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
Resume ExitHere
End Function





#6. Relink all tables ADOX

Public Function RelinkAllTables(Optional strSQLDB As String) As Boolean


Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim fLink As Boolean

On Error GoTo HandleErr
'Open the catalog
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection

For Each tbl In cat.Tables
With tbl
'Only process linked ODBC tables
If .Type = "PASS-THROUGH" Then
fLink = LinkTableADOX(strLinkName:=.Name, strTableName:=.Properties("Jet OLEDB:Remote Table Name"))
'If theres a problem linking one table, then don't bother processing the rest.
If Not fLink Then GoTo ExitHere
End If
End With
Next tbl
RelinkAllTables = fLink

ExitHere:
Set cat = Nothing
Exit Function

HandleErr:
RelinkAllTables = False
MsgBox Prompt:=Err & ": " & Err.Description, title:="Error in RelinkAllTables"
Resume ExitHere


End Function

Public Function LinkTableADOX(strLinkName As String, strTableName As String) As Boolean

Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table

On Error Resume Next
'Point the catalog to the current database
cat.ActiveConnection = CurrentProject.Connection

'if the link already exists, delete it
Set tbl = cat.Tables(strLinkName)
If Err = 0 Then
cat.Tables.Delete strLinkName
Else
Err = 0
End If

'Set the name and parent catalog for the link
tbl.Name = strLinkName
Set tbl.ParentCatalog = cat

'set the properties to create the link
tbl.Properties("Jet OLEDB:Create Link") = True
tbl.Properties("Jet OLEDB:Link Provider String") = "ODBC;Driver={SQL Server}; Server=" & LUT_DATA_SOURCE & ";Database=" & LUT_INITIAL_CATALOG & "; UID=" & LUT_USER_ID & ";PWD=" & LUT_PASSWORD
tbl.Properties("Jet OLEDB:Remote Table Name") = strTableName
tbl.Properties("Jet OLEDB:Cache Link Name/Password") = dbAttachSavePWD
'Append the table to the collection
cat.Tables.Append tbl

Set cat = Nothing

LinkTableADOX = (Err = 0)


End Function




====================


a.
Some people consider you shouldn't be able to alter the backend from the front end. From the point of view of someone that doesn't know anything besides VBA and the jet engine isn't working out for you, your found with no other choice. Whats your best suggestion for VBA alternatives, ?PHP?



b.
In #1 & 3 (add columns & getlinkeddbname) what would you have to change for the code to work with ADO?



c.
Besides #4 , 5 & 6 (rename cols, open connection & relink all tables) + others mentioned what code do you have that can add to this thread? Thanks

 

[DJkarl]

Just my two-cents,
As far as re-linking tables and managing connections through VBA I can see the value in that. Creating / Deleting / Re-creating tables though I use these in code I do not use them often, but enough that I see the need to have a standard method available.

For renaming, dropping, or adding columns this is so rare I don't see a need to do this via code. If you do add or rename a column you will have to go in and change your front-end to make use of the new column, and if it is a temporary column then you would be better off using a query for it. I understand the desire to want to do things through VBA, but just because something can be done this way doesn't mean it should be, or that it makes sense to.

 

[Banana]

I generally agree with DJKarl. I personally don't like to manage backend via Access; it's best to use the tools that are provided with the backend (e.g. SSMS for SQL Server, mysql CLI client or WorkBench for MySQL, Oracle client for Oracle and so forth) and relink the tables accordingly.

 

[mikeo1313]

I also agree, but besides the relink code, I can imagine there be a case where you can manipulate data better with vba.

How can you manage to create a table on the backend, (i.e. mysql) with say a typical select into statement?

 

[Banana]

MySQL's "SELECT INTO" is different from SQL Server / Access / Sybase "SELECT INTO".

You would use CREATE TABLE ... LIKE & INSERT INTO ... or CREATE TABLE ... SELECT.

Next, I don't consider it usual or even desirable to attempt and create a table on backend as a part of application routine. It's one thing when you're calling a stored routine which may then create a table (99% of the time, it'd be temporary anyway) but entirely another thing for one client to go and create a new table externally.

If I were the DBA, I would not be likely to grant the users permission to create tables as well expect via a stored routines that's approved.

 

[mikeo1313]

Let me clarify, when I ran a "select... into" query in VBA "from" a linked odbc table, it created an MS access table on the frontend, not the backend like I wanted it to.

Is it possible? How? From VBA ....