Αλλαγή συνδεδεμένων πινάκων

[th3_b3st]

Καλησπέρα στη παρέα. Έχω μια ερώτηση. Απο μία βάση δεδομένων που την δουλεύω με front και back end αρχεία πως μπορώ να ενημερώσω την συνδεδεμένη βάση (back end) και να δημιουργήσω νέα πεδία σε πίνακες;

βρήκα αυτό.. αλλά ειλικρινά δεν νομίζω ότι είναι τόσο μπελάς..
Microsoft Access adding a field to a linked table

[kapetang]

Καλησπέρα

Πέτρο θα πρότεινα μια λύση χωρίς κώδικα:

1) Άνοιξε στην Access τη BacK End

2) Σε προβολή σχεδίασης των πινάκων, πρόσθεσε τα πεδία που θέλεις και κλείσε τη βάση.

3) Άνοιξε την Frond End.

Τώρα στους συνδεδεμένους πίνακες θα εμφανίζονται και τα νέα πεδία.

Θα πρέπει να τα προσθέσεις «χειροκίνητα» και στις φόρμες , εκθέσεις..., όπου θέλεις να εμφανίζονται.

[th3_b3st]

Καλησπέρα Γιώργο και σε ευχαριστώ πολύ για την απάντηση σου.
Δυστυχώς το ζητούμενο δεν είναι το να το κάνω εγώ γιατί αυτο ακριβώς που είπες κάνω ο ίδιος μου. Θέλω αυτοί που δουλεύουν την εφαρμογή και τους δίνω την αναβάθμιση να ενημερώνετε η βάση δεδομένων τους με τις αλλαγές που έχω κάνει χωρίς να μπαίνω σε διαδικασία να τους πώ πώς θα το κάνουν ή να πρέπει να είμαι ο ίδιος.
Δοκίμασα με τον παρακάτω τρόπο αλλα δεν δουλεύει λόγω διαχωρισμένης βάσης.

Public Sub addColumn()
Dim strField As String
Dim curDatabase As Object
Dim tblTest As Object
Dim fldNew As Object

Set curDatabase = CurrentDb
Set tblTest = curDatabase.TableDefs("Test")

strField = "TestColumn"

Set fldNew = tblTest.CreateField(strField, dbLong)
tblTest.Fields.Append fldNew
End Sub

Ευχαριστώ εκ των προτέρων!

[th3_b3st]

Καλησπέρα και πάλι στη παρέα.
Προσπαθώ να το κάνω να δουλέψει με τον τρόπο του πρώτου ποστ μου αλλά σταματάει στην γραμμή
subRunUpdateQuery strSQL
και μου λέει οτι δεν υπάρχει. Καμία ιδέα κάποιος φίλος/η;

[kapetang]

Καλησπέρα

Πέτρο, δες μια πρόταση στο συνημμένο.

Για να μη σπάσουν οι σύνδεσμοι που υπάρχουν ανάμεσα στους πίνακες του FrontEnd και του BackEnd και να γίνουν εφικτές οι δοκιμές στο σχετικό παράδειγμα:

1) Αντιγράφουμε και αποσυμπιέζουμε το συνημμένο αρχείο *.zip στο φάκελο c:\

2) Με την αποσυμπίεση θα δημιουργηθεί ο φάκελος C:\AddFieldInLinkTable, στον οποίο το αρχείο AddFieldToLinkTable.accdb είναι η FrontEnd βάση και το αρχείο AddFieldToLinkTable_be.accdb η BackEnd βάση.

3) Με διπλό κλικ ανοίγουμε τη βάση AddFieldToLinkTable.accdb

Όταν ανοίγουμε τη φόρμα Form1, ο σχετικός κώδικας γεμίζει το πρώτο cboBox με τα ονόματα των συνδεδεμένων πινάκων.

Το τελευταίο CboBox περιέχει τους τύπους των πεδίων που μπορούμε να προσθέσουμε.

Συνοπτικά επιλέγουμε το όνομα του συνδεδεμένου πίνακα, συμπληρώνουμε στο TextBox ένα όνομα για το πεδίο, επιλέγουμε τον τύπο του πεδίου και πατούμε το κουμπί.

[th3_b3st]

Γιώργο σε ευχαριστώ πολύ για την απάντηση σου. Θα δοκιμάσω το τρόπο που μου αναφέρεις αν και είδα οτι δεν έχει έλεγχο αν η στήλη υπάρχει. Όπως και να έχει θα δοκιμάσω και θα σου πώ εντυπώσεις.
Το πρώτο πόστ το έκανα να δουλέψει μέχρι ένα σημείο αλλά δεν μπόρεσα ακόμη να το κάνω να κάνει ξανά εισαγωγή τον πίνακα.

Option Compare Database

'---------------------------------------------------------------------------------------
' Procedure : subAddTableField
' Author : Neville Turbit
' Date : 21/01/2011
' Purpose : Add a new field to a linked table
'---------------------------------------------------------------------------------------
'

Public Sub subAddTableField(strTableName As String, strFieldName As String, strFieldType As String, Optional strIndex As String)

Dim dbs As Database
Dim strSQL As String
Dim strTablesDatabase As String
Dim tdfLinked As TableDef

On Error GoTo Error_subAddTableField

'---------------------------------------------------------------
' If the table does not exist, exit

If funTableExists(strTableName) = False Then
MsgBox "Ï ðßíáêáò ðïõ æçôÞóáôå äåí õðÜñ÷åé.", vbOKOnly, "ÅíçìÝñùóç"
GoTo Exit_subAddTableField
End If

'---------------------------------------------------------------
' If a local table exists delete it. Checks if table is linked

strTablesDatabase = funGetLinkedDBName(strTableName)

If strTablesDatabase = CurrentDb.Name Then
DoCmd.DeleteObject acTable, strTableName ' Delete the table Could be left over from previous modification. Not likely but best to be safe.
End If

'---------------------------------------------------------------
' Check if the field exists. If it fails proceed with the table modification

On Error GoTo Insert_Field ' If error, the field does not exist

strSQL = "SELECT " & strTableName & "." & strFieldName & " FROM " & strTableName & ";"

Set dbs = CurrentDb
dbs.OpenRecordset strSQL, dbOpenSnapshot, dbSeeChanges

Exit_subAddTableField:
On Error GoTo 0
Exit Sub

Insert_Field:

'---------------------------------------------------------------
' Delete the link (not the table)

Set tdfLinked = dbs.TableDefs(strTableName) ' Select a table. If no database, this will fail.

DoCmd.DeleteObject acTable, tdfLinked.Name ' Delete the link to the table

'---------------------------------------------------------------
' Import, modify and export the table

DoCmd.TransferDatabase acImport, "Microsoft Access", strTablesDatabase, acTable, strTableName, strTableName

strSQL = "ALTER TABLE " & strTableName & " ADD COLUMN " & strFieldName & " " & strFieldType & " " & Nz(strIndex, "")

subRunUpdateQuery (strSQL)

DoCmd.TransferDatabase acExport, "Microsoft Access", strTablesDatabase, acTable, strTableName, strTableName

'---------------------------------------------------------------
' Relink the table

DoCmd.DeleteObject acTable, tdfLinked.Name ' Delete the link
subLinkToOneBETable strTableName, strTablesDatabase ' Relink the table

GoTo Exit_subAddTableField

Error_subAddTableField:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modReleaseSetup" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: subAddTableField" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_subAddTableField
Resume

End Sub

Public Sub subRunUpdateQuery(strSQL As String)
' Run a query in the sql string passed to the sub to update some data
On Error GoTo Error_subRunUpdateQuery

DoCmd.Hourglass (True) ' Turn on the hourglass
DoCmd.SetWarnings False

Set dbs = CurrentDb

Set qdf = dbs.CreateQueryDef("", strSQL) ' Create new QueryDef.
qdf.Execute dbSeeChanges
' Run the insert query

Exit_subRunUpdateQuery:
Set dbs = Nothing 'Clean up
Set qdf = Nothing
strSQL = ""
DoCmd.Hourglass (False) ' Turn off the hourglass
DoCmd.SetWarnings True
Exit Sub

Error_subRunUpdateQuery:
MsgBox "Error in subRunUpdateQuery: " & Err.Number & " - " & Err.Description
Resume Exit_subRunUpdateQuery
End Sub

'---------------------------------------------------------------------------------------
' Procedure : funTableExists
' Author : Neville Turbit
' Date : 04/06/09
' Purpose : Check if the table is already in this Database
'---------------------------------------------------------------------------------------
'
Public Function funTableExists(strTblName As String) As Boolean

Dim dbs As Database
Dim tbl As TableDef
Dim dbsExist As Object

On Error GoTo Error_funTableExists

funTableExists = False

Set dbs = CurrentDb
Set dbsExist = dbs.TableDefs

'--------------------------------------------------------------
' Search for AccessObject objects in AllTables collection.

For Each tbl In dbsExist
If tbl.Name = strTblName Then
funTableExists = True ' Set the function to true
GoTo Exit_funTableExists ' Quit if true
End If

Next tbl

Exit_funTableExists:
On Error GoTo 0
Set dbsExist = Nothing ' Clean up
Exit Function

Error_funTableExists:
MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: funTableExists" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_funTableExists
Resume

End Function

'---------------------------------------------------------------------------------------
' Procedure : funGetLinkedDBName
' Author : Neville Turbit
' Date : 10/11/2010
' Purpose : The funGetLinkedDBName() function requires the name of a
' linked Microsoft Access table, in quotation marks, as an
' argument. The function returns the full path of the originating
' database if successful, or returns 0 if unsuccessful.
'---------------------------------------------------------------------------------------
'
Public Function funGetLinkedDBName(TableName As String)

Dim dbs As DAO.Database
Dim varReturn As Variant

On Error GoTo Error_NoTable ' Handles table not found

'---------------------------------------------------------------
' Find the table

Set dbs = CurrentDb()
varReturn = dbs.TableDefs(TableName).Connect

On Error GoTo Error_funGetLinkedDBName ' Normal error handling

'---------------------------------------------------------------
' Remove the "Database=" from the returned value

funGetLinkedDBName = Right(varReturn, Len(varReturn) - (InStr(1, varReturn, "DATABASE=") + 8))

Exit_funGetLinkedDBName:
On Error GoTo 0
Exit Function

Error_NoTable:
funGetLinkedDBName = "0"
GoTo Exit_funGetLinkedDBName

Error_funGetLinkedDBName:
MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: funGetLinkedDBName" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_funGetLinkedDBName
Resume

End Function

'---------------------------------------------------------------------------------------
' Procedure : subLinkToOneBETable
' Author : Neville Turbit
' Date : 21/01/2011
' Purpose : Link one back end table
'---------------------------------------------------------------------------------------
'

Public Sub subLinkToOneBETable(strTableName As String, strBEPath As String)

Dim dbs As Database
Dim tdf As TableDef ' Tables in this database
Dim tdfLinked As TableDef ' Tables in back end database
Dim strPW As String

'--------------------------------------------------------------
' Check it is a valid path

On Error GoTo Error_subLinkToOneBETable

If funTableExists(strBEPath) = False Then
Call MsgBox("The path provided for the back end database is incorrect. Please ensure the correct path is provided. " _
& vbCrLf & "" _
& vbCrLf & "See your System Administrator." _
, vbCritical, "Missing Database")

GoTo Exit_subLinkToOneBETable

End If

'--------------------------------------------------------------
' Clean up

Set tdf = Nothing
Set dbs = Nothing

'--------------------------------------------------------------
' Relink the files

Set dbs = OpenDatabase(strBEPath, False, False) ' This will fail if there is a password on the BE
Set tdfLinked = dbs.TableDefs(strTableName) ' Select a table. If no database, this will fail.

If funCheck4Nothing(tdfLinked.Name) = True Then ' No tabledef exists
strPW = InputBox("Please enter the database password." & _
" If you do not know the password, see your System Administrator.", _
"Database Password") ' Ask for the password

Set dbs = OpenDatabase(strBEPath, False, False, ";pwd=" & strPW) ' Open the database using the password
End If

If funTableExists(tdfLinked.Name) Then
DoCmd.DeleteObject acTable, tdfLinked.Name
End If

DoCmd.TransferDatabase acLink, "Microsoft Access", _
strBEPath, acTable, tdfLinked.Name, tdfLinked.Name ' Link the table

DoCmd.Hourglass False

Exit_subLinkToOneBETable:
On Error GoTo 0
Exit Sub

Error_subLinkToOneBETable:
MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: subLinkToOneBETable" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_subLinkToOneBETable
Resume

End Sub

'---------------------------------------------------------------------------------------
' Procedure : funCheck4Nothing
' Author : Neville Turbit
' Date : 04/06/09
' Purpose : Check the value passed is null, zero string ("") or zero. Returns true if any of these.
'---------------------------------------------------------------------------------------
'
Public Function funCheck4Nothing(var As Variant)
On Error GoTo Error_funCheck4Nothing

If IsNull(var) Or var = "" Or var = 0 Then
funCheck4Nothing = True
Else
funCheck4Nothing = False
End If

Exit_funCheck4Nothing:
On Error GoTo 0
Exit Function

Error_funCheck4Nothing:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: funCheck4Nothing" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_funCheck4Nothing
Resume

End Function

[kapetang]

Καλησπέρα

Πέτρο, δεν έχω χρόνο και διάθεση να ελέγξω όλον αυτόν τον κώδικα.

Στο συνημμένο, παρουσιάζω ένα αυτοματοποιημένο τρόπο προσθήκης πεδίων.

Έλεγχος για το αν υπάρχει η στήλη γίνεται (αν υπάρχει προκαλείται λάθος και ενημερώνεται ο χρήστης).

Κάνε δοκιμές...…

Σημείωση
Θα μπορούσες να κάνεις εισαγωγή της φόρμας Form1 στο frontEnd της βάσης σου και να κάνεις δοκιμές εκεί.
Επίσης άλλαξα και το συνημμένο στο post #5, λόγω απλοποίησης του κώδικα

[th3_b3st]

Γιώργο σε υπέρ ευχαριστώ για όλα!
Τελικά έβαλα και προσάρμοσα την λύση που μου έδωσες εσύ απλά το έκανα με call. Λίγο με μπέρδεψε το field type το οποίο πρέπει να είναι αριθμός και το είχες σαν πεδίο που δεν φαινόταν στο δικό σου παράθυρο.
Να είσαι πάντα καλα!

[kapetang]

Καλή συνέχεια Πέτρο. Να είσαι καλά!