Discussion :

[Lune1]

Bonjour,
Avec la fonction suivante, j'importe des données qui se trouvent dans une base de données Access vers Excel. Le fichier Excel pourra être partagé à tous les usagers, mais ce n'est pas tous les usagers qui ont accès au dossier partagé où se trouve la base de données Access. Est-ce possible de leur permettre d'y avoir accès en ajoutant mon nom d'utilisateur et mot de passe dans le 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
Public Connexion
 
Function RecherchevAccess(ChampRecherche, valeurRecherche, champRetour, tbl, base)
    Dim GenereCSTRING As String
    Dim rs
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
 
    If Connexion.State = 0 Then
        Fichier = "G:" & "\" & base
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Persist Security Info=False"
        Connexion.Open GenereCSTRING
    End If
 
    Sql = "Select " & champRetour & " FROM " & tbl & " Where " & _
        ChampRecherche & "='" & valeurRecherche & "'"
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open Sql, Connexion, 1, 3
    If rs.EOF = False Then RecherchevAccess = rs(champRetour)
    rs.Close
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
End Function

[Invité]

Bonsoir,

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
Public Connexion
 
Function RecherchevAccess(ChampRecherche, valeurRecherche, champRetour, tbl, base)
    Dim GenereCSTRING As String
    Dim rs
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
 
    If Connexion.State = 0 Then
        PassWord= inputbox("Etrez pass")
        Fichier = "G:" & "\" & base
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Persist Security Info=False;user=admin;Passwors=" & PassWord
    on error resume next
        Connexion.Open GenereCSTRING
    on error goto 0
        if Connexion.State = 0 Then exit fonctions 
    End If
 
    Sql = "Select " & champRetour & " FROM " & tbl & " Where " & _
        ChampRecherche & "='" & valeurRecherche & "'" 
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open Sql, Connexion, 1, 3
    If rs.EOF = False Then RecherchevAccess = rs(champRetour)
    rs.Close
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
End Function

[Lune1]

Bonjour et merci encore. J'ai changé la ligne:

Code :

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

if Connexion.State = 0 Then exit fonctions

Pour :

Code :

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

If Connexion.State = 0 Then Exit Function

Parce qu'il ne semble pas aimer la "fonction" écrit en français. Malheureusement, ça ne fonctionne toujours pas, mais je pense que je me suis mal exprimée: le dossier partagé où se trouve le fichier de base de données Access est en fait un "network drive" (pas sûre du terme français, disque réseau?). J'ai trouvé ce code qui semble proche de ce que j'essaie de faire :

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
Public Sub TestNetShareName()
 
    Dim NetworkObject As Object
    Dim FSO As Object
    Dim Directory As Object
    Dim Filename As Object
    Dim ServerShare As String
    Dim UserName As String
    Dim Password As String
 
    ServerShare = "\\corp-server\HostingFolder"
    UserName = "mydomain\myuser"
    Password = "freddie123"
 
    Set NetworkObject = CreateObject("WScript.Network")
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    NetworkObject.MapNetworkDrive "", ServerShare, False, UserName, Password
 
    Set Directory = FSO.GetFolder(ServerShare)
    For Each Filename In Directory.Files
        Debug.Print Filename.Name
    Next
 
    Set Filename = Nothing
    Set Directory = Nothing
    Set FSO = Nothing
 
    NetworkObject.RemoveNetworkDrive ServerShare, True, False
 
    Set NetworkObject = Nothing
 
End Sub

J'ai bien sûr changé les variables Servershare, Username et password pour tester, mais il bloque toujours à la ligne:

Code :

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

 For Each Filename In Directory.Files

Donc il ne semble pas reconnaître le répertoire. Pourtant, j'ai écrit la variable Servershare sous le même format qu'eux : je ai copié l'équivalent de "\\corp-server\HostingFolder" tel qu'il s'affiche à l'écran de mon ordinateur. Si je peux faire fonctionner ce code, je pourrai peut-être par la suite l'adapter à ma fonction RechercheV.