Probléme dans les arguments d'une fonction

Version imprimable

Bonjour,

Dans le cadre d'un projet sous Excel, je dois construire une base de données regroupant les informations d'un certain nombres de fichier excel (1000). Une ligne par fichier Excel (soit 1000 lignes).
Je récupére les noms et chemins des fichiers et ensuite je désire vérifier l'existance d'un onglet "Form" dans chaques fichiers.

J'ai trouvé sur internet un code me permettant de vérifier l'existance d'un onglet dans un classeur excel sans l'ouvrir :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Private Function OkSheetName(FullPathFile$, SheetName$) As Boolean Dim Con As Object, Cat As Object, Tbl As Object Set Con = CreateObject("ADODB.Connection") Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" _ & FullPathFile & ";" & "Extended Properties=Excel 8.0;" Set Cat = CreateObject("ADOX.Catalog") Set Cat.ActiveConnection = Con For Each Tbl In Cat.Tables If Left$(Tbl.Name, Len(Tbl.Name) - 1) = SheetName Then OkSheetName = True Exit For End If Next Tbl Set Cat = Nothing: Con.Close: Set Con = Nothing End Function
Le probléme est que les 2 arguments FullPathFile$ et SheetName$ sont ici des constantes. Pour mon exercice j'ai besoin que FullPathFile$ soit une variable.

Avez vous des idées/solutions à me proposer?

J'ai lu quelques articles et tutorial sur ces notions de Constante, variable mais rien me permettant de résoudre mon probléme...

N'hesitez pas à me demandez des informations complémentaires.

Cordialement

Bonjour,
Lorsque tu déclares une variable comme constante tu ne peux pas en modifier la valeur.
Pour pallier à ton problème, il suffit de passer par une autre variable et d'utiliser dans ta fonction des arguments qui ne sont pas des constantes.
Philippe Tulliez
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Option Explicit Const FullPathFile$ = "z:\test" Const SheetName$ = "Feuil1" Sub main() Dim repertoire As String, feuille As String repertoire = "c:\toto\test": feuille = "FeuiTrav" MsgBox OkSheetName(repertoire, feuille) End Sub Private Function OkSheetName(wFullPathFile$, wSheetName$) As Boolean ' Ton code End Function

23/12/2010, 16h12
ClementZa
Bonjour et merci pour la réponse.

En faisant cette méthode, il reste toujours une erreur lors de l'éxécution du code ("erreur automation, erreur non spécifiée").
Cette erreur survient lors de l'éxécution de la fonction OkSheetName, à partir des lignes:
Code:

1 2 Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" _ & wFullPathFile & ";" & "Extended Properties=Excel 8.0;"
Je précise que la fonction OkSheetName fonctionne correctement lorsque j'utilise des constante pour FullPathFile et SheetName de maniére :
Code:

1 2 3 4 5 Const FullPathFile = "C:\Documents and Settings\..." Const SheetName = "Form" If (OkSheetName(FullPathFile, SheetName)) Then Else End If

Bonjour,
Je m'étais contenter de répondre à la problématique d'une constante mais je viens de tester le code avec un répertoire et un fichier existant sur mon PC et cela fonctionne. Il me renvoie vrai si le classeur existe et faux s'il n'existe pas.
Testé également si la feuille n'existe pas dans un classeur existant.
Philippe Tulliez

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
 
Option Explicit
Const FullPathFile$ = "z:\test"
Const SheetName$ = "Feuil1"
Sub main()
 Dim repertoire As String, feuille As String
 repertoire = "Z:\Développement\ClasseurZ": feuille = "Feuil1"
 MsgBox OkSheetName(repertoire, feuille)
End Sub
Private Function OkSheetName(FullPathFile$, SheetName$) As Boolean
    Dim Con As Object, Cat As Object, Tbl As Object
    Set Con = CreateObject("ADODB.Connection")
    Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" _
    & FullPathFile & ";" & "Extended Properties=Excel 8.0;"
    Set Cat = CreateObject("ADOX.Catalog")
    Set Cat.ActiveConnection = Con
    For Each Tbl In Cat.Tables
        If Left$(Tbl.Name, Len(Tbl.Name) - 1) = SheetName Then
        OkSheetName = True
    Exit For
        End If
    Next Tbl
    Set Cat = Nothing: Con.Close: Set Con = Nothing
 End Function

27/12/2010, 12h11
ClementZa

Merci, l'erreur vient donc de mon poste.
J'ai vérifié que les références suivantes soient bien activées:
-référence Microsoft ADO ext x.x for DLL and Security
-référence Microsoft ActiveX Data Objects x.x Library

Je ne sais donc pas ou réside l'erreur et je vais me pencher un peu plus sur les liens ADO dans Excel pour voir si j'arrive à comprendre quelque chose.

Merci

Bonjour,

Sans devoir ajouter de référence (relation tardive) et en ouvrant la connexion directement avec le catalogue. Exécuter la proc "ChercherFeuille" en adaptant le chemin du classeur et le nom de la feuille :

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
 
 
Public Function FeuilleExiste(cat As Object, _
                              NomFeuille As String) As Boolean
 
    Dim tbl As Object
    Set tbl = CreateObject("ADOX.Table")
 
    'pacour la collection des tables
    For Each tbl In cat.Tables
        If tbl.Name = NomFeuille Then
            FeuilleExiste = True
            Exit For
        End If
    Next
 
    Set tbl = Nothing
 
End Function
 
Private Sub ChercherFeuille()
 
    Dim cat As Object
    Dim Fichier As String
    Dim NomFeuille As String
 
    Fichier = "C:\Mon Dossier\Mon Classeur.xls"
    NomFeuille = "Form" & "$"
 
    Set cat = CreateObject("ADOX.Catalog")
 
    ' Connexion au classeur
    cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
                           & Fichier & _
                           ";Extended Properties=Excel 8.0;"
 
    MsgBox FeuilleExiste(cat, NomFeuille)
 
    Set cat = Nothing
 
End Sub

Bon courage.

Hervé.

27/12/2010, 15h27
ClementZa
Bonjour Theze et merci pour la solution.

En executant ton code j'ai la même erreur que dans le code précédent ("Erreur Automation, Erreur non spécifiée"). Cette erreur ce produit lors de la ligne :
Code:

1 2 3 cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _ & Fichier & _ ";Extended Properties=Excel 8.0;"
C'est la connexion qui semble poser probléme.
Si la feuille recherchée n'existe pas dans le fichier, la fonction renvoie "FAUX", cependant si cette feuille existe la fonction se met en erreur.

J'ai bidouillé une solution, lors de l'appel de la fonction, qui répond à mon besoin mais n'est pas super propre.
Code:

1 2 3 4 5 6 On Error Resume Next If (VerifierExistenceFeuille(CheminFichier, NomFeuille)) Then ... Else ... End If