ADO – Connexion à une base de données SQL Server

info :
– Excel 2016
– SQL Server 2017
donc choix de la librairie Microsoft ActiveX Data Objects 6.1 Library

voir le code de la base de données supportant cet exemple à la suite du code VBA

Le nom du serveur  se trouve ici dans le champ « Nom du serveur » (remplacer « DESKTOP-4XXXXXX\MONSQL » dans le code VBA ci-desous) et l’authentification est l’autentification Windows.

SQLsERVERcONNECTION


Sub try()

'Microsoft ActiveX Data Objects 6.1 Library

Application.ScreenUpdating = False

Sheets(1).[A3].CurrentRegion.ClearContents

'Configuration de la connexion
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
'Configuration de la methode de mise a jour (add/update/delete)
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
'Configuration du recorset pour l'affichage des resultats
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

Dim aa As Variant

Dim myStringChange As String 'valeur de modification
myStringChange = Range("A1").Value

'String de la connexion (ConnectionString est une methode de cnn)
'ici pas de login et mdp car authentification de sql server configuré en mode "authentification windows"
'DESKTOP-4XXXXXX\MONSQL - nom du serveur
'myDBB est la bdd choisie dans sql server
cnn.ConnectionString = "Provider=SQLNCLI11;Server=DESKTOP-4XXXXXX\MONSQL;Database=filmDB;Trusted_Connection=yes;"

'établissement de la connexion
cnn.Open

'*******************************************************
'*** MODIFICATION DE LA BDD (create, update, delete) ***
'*******************************************************

'Requete (ajout)
'myQuery = "insert into Film(fNom, fResume, fDuree, fDate, idPays, idAnnee, idActeur) values" _
'& "('Le bon, la brute et le truand'," _
'& "'Pendant la Guerre de Sécession, Tuco, Joe et Setenza, trois hommes préférant s''intéresser à leur profit personnel, se lancent à la recherche d''un coffre contenant 200 000 dollars en pièces d''or volé à l''armée sudiste. Chacun a besoin de l''autre...'," _
'& "'03h00','1968-03-08',1,24, 6)"

'requete (suppression)
'myQuery = "delete from Film where idFilm = 7"

'Requete (modif)
'Replace gere le texte contenant des apostrophes
Dim myQuery As String
myQuery = "update Film " _
& "set fNom = '" & Replace(myStringChange, "'", "''") & "' where idFilm = 6"

'parametrages de la mise a jour (add/update/delete)
cmd.ActiveConnection = cnn
cmd.CommandText = myQuery

'execution de la mise a jour (add/update/delete)
cmd.Execute

'*************************************************
'*** AFFICHAGE DES RESULTATS DE LA MISE A JOUR ***
'*************************************************

'curseur côté client, permet de compter le nombre de lignes dans le recordset
'si curseur côté serveur, renvoie -1
rs.CursorLocation = adUseClient

'requete d'affichage
myQuery = "select * from Film"

'enregistrement des resultats de la requete dans le recordset
rs.Open myQuery, cnn

'on recopie les titres des colonnes
For i = 0 To rs.Fields.Count - 1
    Sheets(1).Cells(3, i + 1) = rs.Fields(i).Name
Next i

'si une requête n'a pas de résultat, la transposition d'une string provoque une erreur, donc on place notre string dans un tablo
If rs.RecordCount = 0 Then
    Dim tablo(1, 1) As Variant
    tablo(0, 0) = "No info available"
    aa = tablo
Else
    aa = rs.GetRows
End If

'convertit les dates en numeros de serie
'la colonne E est formatée : Date *14/03/2012
For i = LBound(aa, 2) To UBound(aa, 2)
   aa(4, i) = CLng(aa(4, i))
Next i

'affichage des resultats
Range("A4").Resize(UBound(aa, 2) + 1, UBound(aa) + 1) = Application.Transpose(aa)

rs.Close
cnn.Close

Application.ScreenUpdating = True
End Sub

Création de la BDD MS SQL Server supportant l’exemple ci-dessus


USE master
CREATE DATABASE filmDB
USE filmDB

CREATE TABLE Pays(
	idPays BIGINT IDENTITY(1,1) PRIMARY KEY,
	pPays VARCHAR(200)
)

CREATE TABLE Annee(
	idAnnee BIGINT IDENTITY(1,1) PRIMARY KEY,
	aAnnee INTEGER
)

CREATE TABLE Acteur(
	idActeur BIGINT IDENTITY(1,1) PRIMARY KEY,
	aNom VARCHAR(200),
	aPrenom VARCHAR(200)
)

CREATE TABLE Film(
	idFilm BIGINT IDENTITY(1,1) PRIMARY KEY,
	fNom VARCHAR(200),
	fResume VARCHAR(1000),
	fDuree VARCHAR(5),
	fDate date,
	idPays BIGINT FOREIGN KEY REFERENCES Pays(idPays),
	idAnnee BIGINT FOREIGN KEY REFERENCES Annee(idAnnee),
	idActeur BIGINT FOREIGN KEY REFERENCES Acteur(idActeur)
)

CREATE TABLE Realisateur(
	idRealisateur BIGINT IDENTITY(1,1) PRIMARY KEY,
	rNom VARCHAR(200),
	rPrenom VARCHAR(200)
)

CREATE TABLE Genre(
	idGenre BIGINT IDENTITY(1,1) PRIMARY KEY,
	gGenre VARCHAR(200)
)

INSERT INTO Pays(pPays) VALUES
('Etats-Unis'),
('Royaume-Uni'),
('France')

INSERT INTO Annee (aAnnee) VALUES
(1945),(1946),(1947),(1948),(1949),(1950),(1951),(1952),(1953),(1954),
(1955),(1956),(1957),(1958),(1959),(1960),(1961),(1962),(1963),(1964),
(1965),(1966),(1967),(1968),(1969),(1970),(1971),(1972),(1973),(1974),
(1975),(1976),(1977),(1978),(1979),(1980),(1981),(1982),(1983),(1984),
(1985),(1986),(1987),(1988),(1989),(1990),(1991),(1992),(1993),(1994),
(1995),(1996),(1997),(1998),(1999),(2000),(2001),(2002),(2003),(2004),
(2005),(2006),(2007),(2008),(2009),(2010),(2011),(2012),(2013),(2014),
(2015),(2016),(2017),(2018),(2019)

INSERT INTO Acteur(aNom, aPrenom) VALUES
('Hanks', 'Tom'),
('Neeson', 'Liam'),
('Fonda', 'Henri'),
('Brando', 'Marlon'),
('Pacino', 'Al'),
('Eastwood', 'Clint')

INSERT INTO film(fNom, fResume, fDuree, fDate, idPays, idAnnee, idActeur) VALUES
('Forrest Gump',
'Quelques décennies d''histoire américaine, des années 1940 à la fin du XXème siècle, à travers le regard et l''étrange odyssée d''un homme simple et pur, Forrest Gump.',
 '03h20','1994-10-05',1,50, 1),

('La ligne verte',
'Paul Edgecomb, Gardien-chef du pénitencier de Cold Mountain en 1935, était chargé de veiller au bon déroulement des exécutions capitales. Parmi les prisonniers se trouvait un colosse du nom de John Coffey...',
 '03h09','2000-03-01',1,56, 1),

('La liste de Schindler',
'Evocation des années de guerre d''Oskar Schindler, industriel autrichien rentré à Cracovie en 1939 avec les troupes allemandes. Il va, tout au long de la guerre, protéger des juifs en les faisant travailler dans sa fabrique.',
 '03h15','1994-03-02',1,50, 2),

('12 hommes en colère',
'Lors d''un procès, un juré émet l''hypothèse que l''homme qu''il doit juger n''est peut-être pas coupable. Il va tenter de convaincre les onze autres jurés.',
 '01h35','1957-09-04',1,13, 3),

('Le Parrain',
'En 1945, à New York, les Corleone sont une des cinq familles de la mafia. Don Vito Corleone marie sa fille à un bookmaker. Sollozzo, "parrain" de la famille Tattaglia, propose à Don Vito une association dans le trafic de drogue...',
 '02h55','1972-03-15',1,28, 4),

('Gran Torino',
'Walt Kowalski est un ancien de la guerre de Corée, un homme inflexible, amer et pétri de préjugés surannés. Hormis sa chienne Daisy, il ne fait confiance qu''à son M-1, toujours propre, toujours prêt à l''usage... ',
 '01h51','2009-02-25',1,65, 6)

INSERT INTO Realisateur(rNom, rPrenom) VALUES
('Zemeckis', 'Robert'),
('Darabont', 'Frank'),
('Spielberg', 'Steven'),
('Lumet', 'Sidney'),
('Ford Coppola', 'Francis'),
('Eastwood', 'Clint')

INSERT INTO Genre(gGenre) VALUES
('Drame'),
('Thriller'),
('Action'),
('Aventure'),
('Western'),
('Policier'),
('Historique'),
('Fantastique'),
('Comédie')

-- SELECT * FROM Annee
-- SELECT * FROM Acteur

----SELECT fNom as Titre, fResume as Synopsis, fDuree AS Durée FROM Film
SELECT fNom, fResume, fDuree, pPays, fDate, aAnnee,
aNom AS 'Nom acteur principal', aPrenom AS 'Prenom acteur principal' FROM Film
INNER JOIN Pays ON Film.idPays = Pays.idPays
INNER JOIN Annee ON Film.idAnnee = Annee.idAnnee
INNER JOIN Acteur ON Film.idActeur = Acteur.idActeur
--WHERE aAnnee IN (1994,2000)
WHERE month(fdate)=3
ORDER BY aAnnee

--DELETE Film
--DELETE Pays
--DELETE Annee
--DELETE Acteur
--DELETE Realisateur
--DELETE Genre

--DROP table Film, Pays, Annee, Acteur, Realisateur, Genre

Ci dessous une copie du fichier Excel au format xls :
main.xls

 

ADO – Connexion à un fichier Excel


Sub adoReference()
'Microsoft Scripting Runtime activé
'Microsoft ActiveX DataObjects 6.1 Library activé

Application.ScreenUpdating = False

Sheets("Test").Cells.ClearContents

Dim aa As Variant

Dim myPath As String
myPath = ThisWorkbook.Path

Dim myFile As String
myFile = "ref.xlsx"

Dim tabName As String
'tabName = "Sheet1"
tabName = "info"
'tabName = "info2"'cas de figure sans résultat dans le recordset (bdd vide)

'connexion
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection

'recordset
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

    
'connection au fichier source
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source = " & myPath & "\" & myFile & ";Extended Properties='Excel 12.0;HDR=yes'"

'On place le curseur côté client, cela permet de compter le nombre de lignes dans le recordset
'(si le curseur reste côté serveur, il renvoie la valeur -1)
rs.CursorLocation = adUseClient


'requête
Dim mQuery As String
myQuery = "SELECT *  FROM [" & tabName & "$A1:IV65536] " 'si le nom de la table (ici variable tabName) n'est pas précisé, il prend en compte le 1er onglet

'l'enregistrement de la requête dans le rs s'effectue normalement de la façon suivante :
'Set rs = cnn.Execute("SELECT * FROM [" & tabName & "$A1:IV65536] ")

'mais Set rs = cnn.Execute ne permet pas de compter le nombre de lignes dans le recordset, donc ici, on utilise rs.open
rs.Open myQuery, cnn

'enregistre le nombre de lignes enregistrées dan le rs
Dim sqlRowsCount As Integer
sqlRowsCount = rs.RecordCount



'Definit la celllule à partir de laquelle recopier l'info dans l'onglet
Dim myRange As Range
Set myRange = Sheets("Test").Range("A" & Rows.Count).End(xlUp).Offset(1)

'vérifie qu'il existe bien des résultats à la requête
If sqlRowsCount = 0 Then

    myRange.Value = "Pas de résultat"
Else

    'recopie les en-têtes
    Dim i As Integer
    For i = 0 To rs.Fields.Count - 1
       Cells(1, i + 1).Value = rs.Fields(i).Name
    Next i

    'Copie les résultats de la requête directement sur la feuille de calcull
    'myRange.CopyFromRecordset rs
    
    'enregistre les résultats dans une variable aa
    aa = rs.GetRows
    
    'convertit la date en numero de série pour éviter que la transposition n'inverse le mois et la date
    For i = LBound(aa, 2) To UBound(aa, 2)
    aa(0, i) = CLng(aa(0, i))
    Next i
    
    'affichage
    myRange.Resize(UBound(aa, 2) + 1, UBound(aa) + 1) = Application.Transpose(aa)
    'formatage de la colonne de date
    Columns("A:A").NumberFormat = "dd/mm/yyyy"
End If


rs.Close
cnn.Close

Application.ScreenUpdating = True

End Sub

Fichiers :
ref
main

Transposer des dates depuis une variable tableau

Exemple :
dateTranspose

Sub dateFormat()

'reset l'affichage
Columns("E:Z").ClearContents

'variable aa dans laquelle on enregistre les valeurs du tableau
Dim aa As Variant
aa = Range("A1").CurrentRegion

'transposition des valeurs de la variable sur la feuille Excel à partir de la
'cellule E1 - les 12 premières dates sont inversées par rapport aux valeurs
'initiales de la colonne A
[E1].Resize(UBound(aa), UBound(aa, 2)) = Application.Transpose(Application.Transpose(aa))

'boucle affichant correctement les dates contenues dans la variable aa
'sans passer par la commande de transposition : le problème de changement
'de date est dû à la commande de transposition (Application.Transpose) et non à 
'l'enregistrement des valeurs dans la variable aa
For i = LBound(aa) To UBound(aa)
   Cells(i, 9) = aa(i, 1)
Next i

'changement du type de Date à Long (CLng) - la valeur date devient un numéro de
'série - il suffira juste de reformater correctement la colonne de date pour que
'la transposition soit correcte
For i = LBound(aa) To UBound(aa)
   aa(i, 1) = CLng(aa(i, 1))
Next i
[K1].Resize(UBound(aa), UBound(aa, 2)) = Application.Transpose(Application.Transpose(aa))

End Sub

Fichier d’exemple au formar xls :
 dateTranspose