Récupérer liste des onglets de classeurs sans les ouvrir

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,
Je souhaite envoyer un mailing à 500 destinataires avec 1 fichier Excel en PJ pour chaque destinataire (je récupère le nom du fichier dans une cellule).
Je voudrais, dans le corps du mail, récupérer la liste des onglets du fichier Excel en PJ sans l'ouvrir (ouvrir à chaque fichier des 500 ralentirait notablement l'exécution de mon code, je pense).

Le code du mailing:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Datedujour = Format(Now, "yymmdd")
    Dim Dpt As Long
    Dpt = InputBox(Dpt, "Veuillez renseigner le département cible du publipostage")
    Dossier = "S:\XXXX\Publipostage\Fichiers_" & Datedujour & "\" & Rep
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
 
    On Error GoTo cleanup
    Dim LastLig As Long, Test As String
    Test = InputBox(Test, "S'agit-il du Test pré envoi OUI / NON")
    If Test = "OUI" Then
    Sheets("Test").Select
    Else
    Sheets("Etab_Publipostage").Select
    End If
    LastLig = Range("A5000").End(xlUp).Row
    For j = 2 To LaestLig
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = Cells(j, 4)
       '         
                .Subject = "zzzz"
                .Body = "À l'attention de Madame ou Monsieur du " & Cells(j, 2) & " à " & Cells(j, 3) & " (" & Cells(j, 1) & ")" & Chr(13) _
                & Chr(13) _
                & Chr(13) & "Madame, Monsieur," & Chr(13) _
                & Chr(13) & "...." & Chr(13) _
                & Chr(13) & "Vous trouverez ci-joint un document Excel consignant toutes les incohérences constatées. L'onglet Définitions contient le détail des incohérences et des actions à mener" & Chr(13) _
                & Chr(13) & "Merci de vérifier et éventuellement corriger, ces informations. Si ces informations sont correctes, merci de nous le confirmer par retour de mail." & Chr(13) _
                & Chr(13) & "N'hésitez pas à nous solliciter pour toutes questions." & Chr(13) _
                & Chr(13) & "En vous remerciant par avance," & Chr(13) _
                & Chr(13) & "Cordialement," & Chr(13) _
                & Chr(13) & "..."
                .Attachments.Add ("" & Dossier & "\" & Cells(j, 5) & ".xls")
                .send 
            End With
            On Error GoTo 0
            Set OutMail = Nothing
    Next j
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    MsgBox ("Les mails sont bien envoyés !")

Je vous remercie d'avance pour le coup de main

Bonjour à vous,

Ci-dessous une proposition de code, à utiliser après avoir activer la référence à "Microsoft XML V3.0" :
(NB : inutilisable avec les fichiers aux formats .xlsb ou .xls)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Public Sub ReadXlSheetsNames() Dim shApp As Object, objSource As Object, objTarget As Object Dim xmlDoc As New MSXML2.DOMDocument30, xmlSlct As MSXML2.IXMLDOMSelection, xmlElm As Object Dim tmpPath As String, fPath As String, fName As String, fExt As String fPath = "<chemin_dossier>" fName = "<nom_fichier>" fExt = "<extension_fichier>" Name fPath & fName & fExt As fPath & fName & ".zip" Set shApp = CreateObject("Shell.Application") Set objSource = shApp.Namespace(fPath & fName & ".zip").Items.Item("xl\workbook.xml") MkDir Environ("TEMP") & "\TempUnzip\" shApp.Namespace(Environ("TEMP") & "\TempUnzip\").CopyHere objSource, 256 xmlDoc.Load (Environ("TEMP") & "\TempUnzip\workbook.xml") Set xmlSlct = xmlDoc.getElementsByTagName("sheet") For Each xmlElm In xmlSlct Debug.Print xmlElm.Attributes(0).NodeValue Next xmlElm Kill Environ("TEMP") & "\TempUnzip\*.*" RmDir Environ("TEMP") & "\TempUnzip\" Name fPath & fName & ".zip" As fPath & fName & fExt End Sub
Adaptez les définitions des variables fPath, fName et fExt. Notez que fExt doit commencer par un point (".xlsx" par exemple).

Pour le principe :

On crée un dossier temporaire,
On renomme le fichier Excel pour changer son extension en .zip,
On extrait le fichier /xl/workbook.xml du fichier .zip vers le dossier temporaire,
On ouvre le fichier xml et on y lit les noms des feuilles,
On supprime le dossier temporaire et son contenu.

Cdt

2 pièce(s) jointe(s)

Avec un code trouvé sur internet:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub ListeFeuillesClasseurFerme()
Dim XlConnect As Object, XlCatalog As Object
Dim Fichier As String, Resultat As String
Dim Feuille As Object
 
Fichier = "S:\___\PERSONNE\xxx\SAUVEGARDE CONTROLES\zzzz_210916.xls"
 
Set XlConnect = CreateObject("ADODB.Connection")
Set XlCatalog = CreateObject("ADOX.Catalog")
 
XlConnect.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & _
";Extended Properties=Excel 8.0;"
Set XlCatalog.ActiveConnection = XlConnect
 
For Each Feuille In XlCatalog.Tables
Resultat = Resultat & Feuille.Name & vbCrLf
Next
 
MsgBox Resultat
End Sub

Les références activées suivantes:
Pièce jointe 605252

Rien à faire: Erreur:
Pièce jointe 605253

1 pièce(s) jointe(s)

Un autre code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
 
Sub ZZZZListeFeuillesClasseurFerme()
    Dim Cn As ADODB.Connection
    Dim Fichier As String
    Dim xlSheet As Variant
 
    'Définit le classeur fermé servant de base de données
    Fichier = "S:\___\PERSONNExxx\SAUVEGARDE CONTROLES\zzz_210916.xls"
 
 
    Set Cn = New ADODB.Connection
    Set cat = CreateObject("ADOX.Catalog")
    '--- Connexion ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
 
Set cat.ActiveConnection = Cn
For Each xlSheet In cat.Tables
Resultat = Resultat & xlSheet.Name & vbCrLf
Next
MsgBox Resultat
'--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
    Set cat = Nothing
End Sub

Erreur:
Pièce jointe 605254

Je n'avais pas du tout pensé à utiliser une connexion ADODB. L'idée est excellente !
Ci-dessous un code qui fonctionne chez moi.
Attention toutefois, le nom des feuilles est suivi du signe "$".

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub ReadSheetsNames()
    Dim Cnn As ADODB.Connection, Ctlg As Object
    Dim StrCon As String, Resultat As String, fPath As String
    Dim xlSheet As Variant
    fPath = "<chemin_complet_fichier>"
    StrCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fPath & _
             ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
    Set Cnn = New ADODB.Connection
    Cnn.Open StrCon
 
    Set Ctlg = CreateObject("ADOX.Catalog")
    Set Ctlg.ActiveConnection = Cnn
    For Each xlSheet In Ctlg.Tables
        Resultat = Resultat & xlSheet.Name & vbLf
    Next
    Cnn.Close
    MsgBox Resultat
End Sub

J'ai utilisé la référence à "Microsoft ActiveX Data Objects 6.1 Library" mais du late binding ferait aussi bien l'affaire.

Cdt

27/09/2021, 12h44
Kestion100

MERCI

Je teste et reviens sur le forum
27/09/2021, 13h11
Kestion100

Le premier code est parfait, pour le deuxième, j'ai un plantage:

Code:

Cnn As ADODB.Connection

Erreur de compilation:

Typer défini par l'utilisateur non défini
...???
27/09/2021, 13h14
Kestion100

J'ai commencé à regarder un peu à quoi correspond le Late Biding qui semble intéressant en effet mais l faudra que je passe plus de temps dessus

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub test()
Dim cn As Object, AvecTitre As Boolean, Fichier As String, T() As String
AvecTitre = True
Fichier = "C:\Myrep\Classeur1.xlsx"
Set cn = CreateObject("AdoDb.connection")
With cn
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=" & Array("No", "YES")(Abs(AvecTitre)) & ";"""
    T() = Tables(cn)
    .Close
End With
End Sub
Public Function Tables(cn As Object) As String()
 
Dim T() As String, i As Integer
With cn.OpenSchema(20)
    While Not .EOF
        ReDim Preserve T(i)
        T(i) = !TABLE_NAME
        i = i + 1
        .MoveNext
    Wend
    .Close
    Tables = T
End With
End Function

27/09/2021, 14h14
Kestion100

Celui là est très bien aussi (il y a les "$". On peut gérer avec un mid()?) comment récupérer la table finale?
J'ai essayé T() Tables().... après un Debug.print mais à chaque fois, "incompatibilité de type.....

Je ne comprends pas quel est le problème !

Code:

1
2
3
For Each tb In T
    Debug.Print tb
Next

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function Tables(cn As Object) As String()
Dim T() As String, i As Integer
With cn.OpenSchema(20)
    While Not .EOF
        ReDim Preserve T(i)
        T(i) = Replace(!TABLE_NAME,"$", "")
        i = i + 1
        .MoveNext
    Wend
    .Close
    Tables = T
End With
End Function

27/09/2021, 14h58
Ben_L
Citation:

Envoyé par Kestion100

J'ai commencé à regarder un peu à quoi correspond le Late Biding qui semble intéressant en effet mais l faudra que je passe plus de temps dessus

Bonjour,

La formulation :
Code:

1 2 Dim Cnn As ADODB.Connection Set Cnn = New ADODB.Connection
correspond à du "Early binding". Dès la déclaration de l'objet, on lui attribue un type. Pour cela, il est nécessaire que la référence à la librairie "Microsoft ActiveX Data Objects 6.1 Library" soit définie. Cela explique probablement votre plantage.

La formulation :
Code:

1 2 Dim Cnn As Object Set Cnn = CreateObject("AdoDb.connection")
proposée par Thumb down correspond à du "Late binding". Dans ce cas, inutile d'ajouter une référence à une librairie.
La classe précise de l'objet n'est pas définie au moment de sa déclaration. C'est lors de l'initialisation de l'objet que la fonction CreateObject ira chercher la définition nécessaire, sur la base de la chaîne de caractères qui lui est fournie.

Concernant les "$", il me semble qu'il n'est pas possible d'en inclure un dans un nom d'onglet. Donc Replace(xlSheet.Name, "$", "") devrait faire l'affaire.
Une autre solution serait d'utiliser Left(xlSheet.Name, Len(xlSheet.Name) - 1).
Enfin, le plus sûr est probablement :

Code:

Replace(xlSheet.Name, "$", "", Len(xlSheet.Name) - 1)

puisque cela permet de ne remplacer le "$" que s'il se trouve en dernière position.

Cdt
27/09/2021, 15h15
Kestion100

OK, j'y vois bien plus clair.

Replace, parfait pour les $, en effet, ta solution de remplacer le dernier est plus sûre (j'utilise rarement pour ma part ce caractère dans les noms de mes onglets.

MERCI, PREFECT

1 pièce(s) jointe(s)

Salut.

Tu pourrais, à partir de Excel 2010, récupérer les feuilles par Power Query, ce qui t'évite de passer par une connexion ADODB en VBA. Tu peux alors intégrer l'actualisation de la requête Power Query dans ton code VBA, et gérer les données du tableau résultant en VBA également.

Voici le tableau t_Fichiers contenant les noms des fichiers. Ici, j'ai imaginé que le fichier choisi correspond à celui ayant un x, et la requête Power Query qui récupère les feuilles contenues dans le fichier^(*)...

Pièce jointe 605550
Code:

1 2 3 4 5 6 let Fichier = Table.SelectRows(Excel.CurrentWorkbook(){[Name="t_Fichiers"]}[Content], each ([Choix] = "x")){0}[Classeur], Source = Table.SelectRows(Excel.Workbook(File.Contents(Fichier)), each [Kind] = "Sheet"), Feuilles = Table.SelectColumns(Source, {"Name"}) in Feuilles
Bien sûr, la sélection du fichier peut s'effectuer autrement que par une croix, et passer par exemple, en VBA, par la copie du nom du fichier dans une plage nommée qui est récupérée par Power Query.

^(*) Avec un peu plus d'étapes, cette requête peut être entièrement presqu'entièrement construite par clics dans l'interface Power Query. Il faut "juste" y insérer la récupération du nom du classeur (si l'on travaille avec une plage nommée pour le nom du classeur, c'est une simple insertion par copier-coller)

27/09/2021, 15h29
Pierre Fauconnier

Salut Ben,

Citation:

Envoyé par Ben_L

[...]
Concernant les "$", il me semble qu'il n'est pas possible d'en inclure un dans un nom d'onglet[...]

Les versions actuelles acceptent le $ dans le nom de l'onglet ;)

Attention que pour le Late Binding, on ne bénéficie pas de la saisie semi-automatique (ou auto-complétion) puisque le type de l'objet n'est pas connu et que sa bibliothèque n'est pas disponible. On travaille donc "à l'aveugle" en n'étant pas aidé par l'éditeur.

A voir s'il est utile, dans ce cas-ci, de travailler en Late Binding. En cas de fichier non utilisé sur un autre poste, travailler en Early Binding me semble indiqué.
27/09/2021, 15h41
Kestion100

Passer par Power Query peut en effet être intéressant.

Dans le cadre de ce que je fait en rapport avec ces posts, je cherche à récupérer cette liste pour l'inscrire dans le corps d'un mail ayant le fichier en PJ, donc sans passer par une feuille Excel.
27/09/2021, 15h47
Kestion100

Je ne m'y connais que peu en Power Query, je travaille avec en utilisant des fichiers .laccdb.dsn que je génère en utilisant Access, je crois d'une manière pas très académique.

Comment procèdes-tu dans ce cas, tu passes par une feuille Excel pour la liste des fichiers et tu fais une requête après?
27/09/2021, 15h47
Pierre Fauconnier

Avec Power Query, on passe par une feuille pour récupérer le tableau structuré résultant de la requête. Mais ce tableau peut être sur une feuille masquée. Ca ne pose pas de problème.

L'idée de mon post est simplement de montrer que l'on peut récupérer les noms des feuilles en Power Query en utilisant soit un tableau structuré soit une plage nommée pour que Power Query puisse récupérer le nom du classeur voulu et placer les noms de ses feuilles dans un tableau structuré. L'avantage, ou pas, est qu'il récupère également les feuilles de graphique.

Après, à toi de voir si tu préfères articuler ton code autour de cette conception ou de récupérer avec ADO... ;)
27/09/2021, 16h01
Ben_L

Bonjour Pierre,

Citation:

Envoyé par Pierre Fauconnier

Les versions actuelles acceptent le $ dans le nom de l'onglet ;)

Merci à vous pour cette précision, je l'ignorais ! :plusser:

Concernant le Early/Late binding, j'avoue m'interroger sur le comportement du VBA dans le cas où la librairie utilisée n'est pas correctement référencée dans le registre Windows (cas où l'ajout de la référence n'est soit pas possible, soit provoque l'émission de messages d'avertissement).
Sauriez-vous si le Late Binding fonctionne mieux dans ce cas (impossible pour moi de faire le test pour l'instant) ?

Cdt
27/09/2021, 16h05
Pierre Fauconnier

Citation:

Envoyé par Ben_L

[...]

Le Late Binding est normalement plus fiable car le modèle objet bouge peu d'une version à l'autre, grâce à la compatibilité montante. Par contre, en Early Binding, si on référence une bibliothèque qui n'existe pas sur le poste sur lequel le code tournera, on aura un problème.

Généralement, on développe en early et on monte en prod en late... Il y a un billet ou une contribution de de Philippe Tulliez sur le sujet. Je ne sais pas retrouver le lien pour l'instant. J'essaierai de le poster tout à l'heure.

Voir 40 message(s) de cette discussion en une page