MacroFacili: Modifica struttura DB

Lavorando con file distinti (foglio di calcolo e database), spesso nel caso di aggiunta di dati si rende necessario modificare di conseguenza anche il database. In questo caso una buona soluzione è quella di inserire le modifiche da apportare al DB in una macro da inserire direttamente nel file.

In questo modo non sarà necessario ne farsi mandare il database (che spesso è anche di grande dimensione) se non lavoriamo nella stessa sede dell'utilizzatore, ne modificare il file manualmente. E' molto comodo anche nel caso l'utente dei file ritorni ad utilizzare una versione vecchia del database (succede molto più spesso di quanto si possa immaginare), ad esempio recupera un backup.

La macro di esempio qui sotto verifica se nel database è presente un campo di una tabella e una tabella intera, nel caso non sia così fa le modifiche sul database aggiunge il campo o creando la tabella.

Dim Cn As ADODB.Connection
Dim T1 As ADODB.Recordset

Sub CambiaStrutturaDB()
  Set Cn = New ADODB.Connection
  FileDB = Application.ThisWorkbook.Path & "DbDemo.accdb"

  '--- link ADO ---
  Provider = "Microsoft.ACE.OLEDB.12.0"
  DataLink = "Provider=" + Provider + ";Data Source=" + FileDB + ";Persist Security Info=False"
  Set Cn = New ADODB.Connection
  Cn.Open DataLink

  Set T1 = New ADODB.Recordset

  Modificato = False

  '--- Campo ---
  If Not (HaCampo("Tabella1", "Campo5")) Then
    StQ = "Alter table Tabella1 Add column Campo5 String 20"
    Cn.Execute (StQ)
    Modificato = True
  End If

  '--- Tabella ---
  If Not (HaTabella("Tabella1")) Then
    StQ = "CREATE TABLE Tabella1(Campo1 SmallInt,Campo2 SmallInt,Campo3 SmallInt,Campo4 float)"
    Cn.Execute (StQ)
    Modificato = True
  End If

  If (Modificato) Then
    Msg = "Il database è stato aggiornato."
  Else
    Msg = "Database già aggiornato."
  End If
  Res = MsgBox(Msg, vbOKOnly, "Aggiornamento database")
End Sub

Questa macro permette di controllare se un campo esiste nella tabella:

Private Function HaCampo(NomeTabella, NomeCampo)
  Trovato = False

  T1.Open "SELECT * From " + NomeTabella, Cn, adOpenKeyset, adLockOptimistic, adCmdText

  For i = 0 To T1.Fields.Count - 1
    If (T1.Fields(i).Name = NomeCampo) Then
      Trovato = True
      Exit For
    End If
  Next i
  T1.Close

  HaCampo = Trovato
End Function

Questa permette di controllare se una tabella è già presente sul database:

Private Function HaTabella(NomeTabella)
  Trovata = True
  Q = "SELECT Count(*) AS NomeTabella" + _
      "FROM " + NomeTab + " "

  On Error GoTo errHandler
    T1.Open Q, Cn
    T1.Close
    GoTo Trovata

errHandler:
    Trovata = False

trovata:
  HaTabella = Trovata
End Function