Discussion :

[Kestion100]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Ben_L]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Pierre Fauconnier]

Maintenant, la mécanique est bonnne

Ce qui pose problème, c'est que tu essaies d'ouvrir un xls (version 2003). Or, Poqer Query ne récupère pas le contenu de ces fichiers de la même manière => les colonnes présentes dans la structure PQ du fichier ne sont pas identiques...

Versions xlsx ou xlsm




Versions XLS



Es-tu sûr de tes fichiers xls?

[Kestion100]

OK avec:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Option Explicit
 
Sub Test()
 
  Dim r As Range
 
 
 
    Range("Fichier").Value = Cells(ActiveCell.Row, ActiveCell.Column).Value
    On Error Resume Next
    Range("pq_Feuilles").ListObject.QueryTable.Refresh True
 
    MsgBox Application.Evaluate("textjoin("" - "",true,pq_Feuilles)")
    Application.EnableEvents = True
 
 
End Sub

[Kestion100]

OK, je peux virer les fichiers .xls, aucun problème

[Kestion100]

En fait le code fonctionne avec les deux .xls et .xlsx, avec .xls, j'ai l'erreur qui s'affiche mais je récupère les noms de mes onglets quand même

[Kestion100]

Avec un code trouvé sur internet:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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:


Rien à faire: Erreur:

[Kestion100]

Un autre code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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:

[Ben_L]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Kestion100]

MERCI

Je teste et reviens sur le forum

[Kestion100]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cnn As ADODB.Connection

Erreur de compilation:

Typer défini par l'utilisateur non défini
...???

[Pierre Fauconnier]

Sinon, on aiguille la requête en fonction de ce qu'elle a reçu et de la présence de la colonne ou non...

[Thumb down]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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.....

[Pierre Fauconnier]

Voici la requête Power Query adaptée aux deux formats. Elle consiste en l'ajout d'une colonne qui teste la présence de la colonne Kind. Si Kind est présente, la colonne formulée reprend son contenu, sinon elle reprend la valeur "Sheet".

Avec cette adaptation, la requête passe sans erreurs^(*) sur les xlsx et les xls

Code PowerQuery :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
let
    Fichier = Excel.CurrentWorkbook(){[Name="Fichier"]}[Content]{0}[Column1],
    Source = Excel.Workbook(File.Contents(Fichier)),
    AjoutColonne = Table.AddColumn(Source, "Personnalisé", each if Table.HasColumns(Source, {"Kind"}) then [Kind] else "Sheet"),
    Filtre = Table.SelectRows(AjoutColonne, each [Personnalisé] = "Sheet"),
    Resultat = Table.SelectColumns(Filtre,{"Name"})
in
    Resultat

^(*) Par contre, Power Query ne fait pas la différence entre une feuille et une plage nommée pour les xls. Je n'ai pas vu d'éléments dans la requête qui permettait de ne sélectionner que les feuilles. Mais (je botte en touche ), il me semble que depuis 2007 (soit 14 ans), on a normalement eu le temps de faire migrer ses classeurs xls vers les versions actuelles de l'outil

[Thumb down]

Je ne comprends pas quel est le problème !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Pierre Fauconnier]

Tu dois aller dans Fichier>Informations puis à hauteur du bouton "Vérifier l'absence de problèmes", cliquez sur "Autoriser l'enregistrement de ces informations dans le fichier"...

En général, lorsque je poste un fichier, j'en enlève les infos persos, d'où ce message à l'enregistrement...

[Kestion100]

J'ai bien compris les principes de base et ferai appel à tes tutos, je pense que ce domaine que j'ignorais complètement ouvre plein de possibilités.

As usual with Pierre Fauconnier, PERFECT

Merci

[Pierre Fauconnier]

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^(*)...

Code PowerQuery :

Sélectionner tout - Visualiser dans une fenêtre à part

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)

[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...