[2007]Runtime GetOpenFileName n'ouvre pas la boite. [Résolu]

[tAKAmAkA]

Bonjour à tous,

Et merci d'être là...

Lors d'une nouvelle installation d'une appli en runtime 2007 la boite de sélection d'un fichier (GetOpenFileName) ne s'ouvre pas!
Je n'ai pas de message d'erreur, juste une indication dans le badeau du bas du genre calculating...

Le code qui m'appelle la fonction sert à demander le chemin vers une dorsale en cas d'erreur 3044

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Private Sub Form_Activate()
Dim strChemin As String
On Error GoTo Err_Form_Activate
DoCmd.Maximize
Me.txtNomBase.Value = DLookup("[NomBase]", "tblConstante", "[CstId] = 1")
Me.txtMillesime.Value = DLookup("[DernierMillesime]", "qryMillesime")
'Ne pas mettre le focus sur les objets qui peuvent être masqués.
Me.txtGardienFocus.SetFocus
Exit_Form_Activate:
    Exit Sub
Err_Form_Activate:
    Select Case err.Number
            Case 3024, 3044  'Erreur levée si Access ne trouve pas la base Principale ou le chemin n'est pas valide
            If MsgBox("La connexion à la base principale à échouée, " & vbCrLf & _
            "voulez-vous redéfinir les liaisons ?", vbYesNo + vbExclamation, "xxx") = vbYes Then
 
annul:
                'Ouverture de la fenêtre Windows et stockage du chemin dans la variable
                strChemin = OuvrirUnFichier(Me.hwnd, "Parcourir", 1, "Fichiers Base de Données", "mdb")
 
                'Test si présence de caractères dans la variable au cas où l'utilisateur annule
                If Len(strChemin) <> 0 Then
                    'Appel Fonction de Liaison table avec le chemin en paramètre et test retour de la fonction
                    If LierTables(strChemin) = True Then
                                           MsgBox "Liaison rétablie vers une base de donnée.", , "xxx"
 
                    Else
                        'Message si la fonction n'a pas renvoyer le True
                        MsgBox "Mise à jour des Tables non effectuées, " & vbCrLf & _
                        "veuillez contacter l'administrateur de la base.", vbCritical, "ANAsoft"
                        'Fermeture de l'application
                        DoCmd.Quit
                    End If
                Else
                    'Message si l'utilisateur à annulé la sélection du chemin
                    If MsgBox("Annulation par utilisateur." & vbCrLf & _
                    "Voulez-vous fermer l'application ?", vbYesNo + vbInformation, "xxx") = vbYes Then
                        'Fermeture de l'application
                        DoCmd.Quit
                    Else
                        'retour début procédure d'appel des fonctions
                        GoTo annul
                    End If
                End If
            Else
                'Fermeture de l'application
                DoCmd.Quit
            End If
        Case 3043   'Erreur levée si Access n'arrive ps à se connecter au réseau
            MsgBox "Il est impossible de se connecter au réseau," & vbCrLf & _
            "veuillez contacter votre administrateur réseau.", vbCritical, "xxx"
                    If MsgBox("Problème de connexion réseau." & vbCrLf & _
                        "Voulez-vous fermer l'application ?", vbYesNo + vbInformation, "xxx") = vbYes Then
                        'Fermeture de l'application
                        DoCmd.Quit
                    Else
                        'retour début procédure d'appel des fonctions
                        GoTo annul
                    End If
        Case 3049, 3428 'Base Principale corrompue
            MsgBox "La base principale est endommagée," & vbCrLf & _
            "veuillez contacter l'administrateur de cette base.", vbCritical, "xxx"
                    If MsgBox("Problème de base endommagée." & vbCrLf & _
                        "Voulez-vous fermer l'application ?", vbYesNo + vbInformation, "xxx") = vbYes Then
                        'Fermeture de l'application
                        DoCmd.Quit
                    Else
                        'retour début procédure d'appel des fonctions
                        GoTo annul
                    End If
       Case Else
        MsgBox "Erreur frmAccueil_Form_Activate n°: " & err.Number & vbCrLf & err.Description, , "xxx"
 
    Resume Exit_Form_Activate
    End Select
 
End Sub

Le résultat est que le code "voit" un chaine de longueur nulle et s'aiguille vers le cas "annulation par l'utilisateur".
Je ne pense pas qu'il y ai un pb dans cette partie car l'appel de GetOpenFileName dans d'autres contexte ne marche pas mieux.

J'ai installé le package runtime de nombreuses fois sur UN poste vista et ça fonctionne.

Le problème se produit sur un poste en xp pro sp2 avec access 2000 installé.

Les déclarations dans mon module:

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
49
'***ooo***Déclarations pour OuvrirUnFichier(avec GetOpenFileName)
'Déclaration de l'API
'**Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
                   "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 'Structure du fichier
Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 'Constantes (commentaires suivant d'après MZtools)
'Private Const OFN_READONLY = &H1
'Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
'Private Const OFN_NOCHANGEDIR = &H8
'Private Const OFN_SHOWHELP = &H10
'Private Const OFN_ENABLEHOOK = &H20
'Private Const OFN_ENABLETEMPLATE = &H40
'Private Const OFN_ENABLETEMPLATEHANDLE = &H80
'Private Const OFN_NOVALIDATE = &H100
'Private Const OFN_ALLOWMULTISELECT = &H200
'Private Const OFN_EXTENSIONDIFFERENT = &H400
'Private Const OFN_PATHMUSTEXIST = &H800
'Private Const OFN_FILEMUSTEXIST = &H1000
'Private Const OFN_CREATEPROMPT = &H2000
'Private Const OFN_SHAREAWARE = &H4000
'Private Const OFN_NOREADONLYRETURN = &H8000
'Private Const OFN_NOTESTFILECREATE = &H10000
'Private Const OFN_SHAREFALLTHROUGH = 2
'Private Const OFN_SHARENOWARN = 1
'Private Const OFN_SHAREWARN = 0

Je me rends compte, de retour au bureau, que j'ai cru malin il y a un moment déjà, de mettre en commentaire toute une série de déclarations suite au diagnostique de MZtools qui me déclarai ces variables en "inutilisé".
D'autre part je vois que

Code :

Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)

est aussi en commentaire.
Pensez-vous que celà puisse venir de là?
(Vous me direz:"t'as qu'a essayer...)

La suite:

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
Public Function OuvrirUnFichier(Handle As Long, _
                                Titre As String, _
                                TypeRetour As Byte, _
                                Optional TitreFiltre As String, _
                                Optional TypeFichier As String) As String
Dim StructFile As OPENFILENAME
Dim sFiltre As String
 'Construction du filtre en fonction des arguments spécifiés
If Len(TitreFiltre) > 0 And Len(TypeFichier) > 0 Then
  sFiltre = TitreFiltre & " (" & TypeFichier & ")" & Chr$(0) & "*." & TypeFichier & Chr$(0)
End If
sFiltre = sFiltre & "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)
 
 'Configuration de la boîte de dialogue
  With StructFile
    .lStructSize = Len(StructFile) 'Initialisation de la grosseur de la structure
    .hWndOwner = Handle 'Identification du handle de la fenêtre
    .lpstrFilter = sFiltre 'Application du filtre
    .lpstrFile = String$(254, vbNullChar) 'Initialisation du fichier '0' x 254
    .nMaxFile = 254 'Taille maximale du fichier
    .lpstrFileTitle = String$(254, vbNullChar) 'Initialisation du nom du fichier '0' x 254
    .nMaxFileTitle = 254  'Taille maximale du nom du fichier
    .lpstrTitle = Titre 'Titre de la boîte de dialogue
    .flags = OFN_HIDEREADONLY  'Option de la boite de dialogue
  End With
 
  If (GetOpenFileName(StructFile)) Then 'Si un fichier est sélectionné
    Select Case TypeRetour
      Case 1: OuvrirUnFichier = Trim$(StructFile.lpstrFile)
      Case 2: OuvrirUnFichier = Trim$(StructFile.lpstrFileTitle)
    End Select
  End If
End Function

Si j'ai bien compris c'est une API et son fonctionnement ne dépend pas d'une référence à déclarer mais de la présence du fichier comdlg32.dll .Je n'ai pas encore contrôlé sa présence dans système32.
Mon problème peut-il venir de ce fichier?

Si vous pouviez me donner plusieurs pistes que je puisse aller chez le client avec des billes...

Merci de votre attention.

[argyronet]

Bonjour,

Il va être difficile de déboger cela en mode RUNTIME chez le client...

Que donne ton projet sur ton poste une fois renommé en accdr ?
(Extension de simulation du mode runtime)...
Est-ce le même symptôme ?

Si oui, alors change de stratégie et effectue ces modifs (si tu es pris(es) par le temps.)

Déclare d'un objet FileDialog pour la boîte de dialogue Ouvrir en faisant référence à Microsoft Office 12.
Tu peux alors utiliser cette fonction, autrement plus courte que l'API :

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
Private Function OuvrirDialogueFichier() As String
Dim strNomFichier As String
Dim oFDLG As FileDialog
 
  ''''Paramètres la boîte de dialogue Ouvrir
  Set oFDLG = Application.FileDialog(msoFileDialogOpen)
  With oFDLG
      '''' Ajout des filtres pour fichiers de tous types
      With .Filters
          .Clear
          .Add "Tous fichiers", "*.*", 1
      End With
      '''' Affectation d'un titre
      .Title = "Sélectionner un fichier"
      '''' Ouvre l'explorateur dans le dossier 'Mes documents'
      .InitialFileName = "C:\Documents and Settings\argyronet\Mes documents"
      '''' Empêche la sélection multiple de fichiers
      .AllowMultiSelect = False
      '''' Définition du mode de visu en miniature
      .InitialView = msoFileDialogViewDetails
      '''' Affecte la légende du bouton
      .ButtonName = "Ouvrir"
 
      ''''Affiche la fenêtre avec gestion d'erreur
      On Error GoTo SelectionAnnulee
      .Show
      '''' Affecte le fichier image à la variable
       strNomFichier = .SelectedItems(1)
  End With
SortieAjout:
  OuvrirDialogueFichier = strNomFichier
  Set oFDLG = Nothing
  Exit Function
SelectionAnnulee:
  strNomFichier = vbNullString
  MsgBox err.Description, , "Erreur n°" & err.Number
  Resume SortieAjout
End Function

Tu rééessayes en mode runtime (accdr) après quoi, tu risques de pouvoir aller chez ton client, j'espère...
Ensuite tu créé ton accde et tu retestes avec cette extension puis de nouveau en accdr sur le accde.

Argy

[tAKAmAkA]

Merci argy pour ta réponse,

Sur mon poste , rennommé en accdr et lancé avec /runtime, ainsi que sur un autre poste en vrai runtime il n'y a pas de problème.

D'autre part il me semble que la fonction de sélection d'un répertoire ne marche pas mieux.

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
49
50
51
52
53
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
        ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
        ByVal lpString2 As String) As Long
Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
Public Function SelectFolder(Titre As String, Handle As Long) As String
    Dim lpIDList As Long
    Dim strBuffer As String
    Dim strTitre As String
    Dim tBrowseInfo As BrowseInfo
    strTitre = Titre
    With tBrowseInfo
        .hWndOwner = Handle
        .lpszTitle = lstrcat(strTitre, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
        strBuffer = String(260, vbNullChar)
        SHGetPathFromIDList lpIDList, strBuffer
        SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    End If
End Function
Public Function SelectFolder(Titre As String, Handle As Long) As String
    Dim lpIDList As Long
    Dim strBuffer As String
    Dim strTitre As String
    Dim tBrowseInfo As BrowseInfo
    strTitre = Titre
    With tBrowseInfo
        .hWndOwner = Handle
        .lpszTitle = lstrcat(strTitre, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
        strBuffer = String(260, vbNullChar)
        SHGetPathFromIDList lpIDList, strBuffer
        SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    End If
End Function

Je dis "il me semble" car c'est une constation que j'ai faite en vitesse, au dernier moment, avant de me faire enfermer dans le bureau du client pour la nuit...
Y-a-t-il un point commun entre les deux fonctions?

Dans tous les cas je prépare une solution de repli avec la fonction que tu m'a communiquée.

Question subsidiaire: si je ne fais pas de modif nécessitant des références, je peux renommer mon MDE (je suis resté au format 2003 pour la sécurité) en ACCDR et le copier à la place de celui du client?
Tu en parles dans ton tuto, mais c'est juste pour confirmer...
Car si j'ai la possibilité de faire des modifs sur place sur mon portable et cela me permettrai 1:de gagner du temps, 2:de ne pas "déranger" le responsable informatique pour me connecter en administrateur.

[argyronet]

Si tu renommes en accdr, tu n'as pas besoin du /runtime.
Le fait de renommer avec cette extension (pour 2007 uniquement), te permets de contrôler localement le comportement de ton appli lorsque celle-ci est prête ) être distribuée dans l'objectif de le faire sur des postes dépourvus de la version complète d'Access 2007.
C'est soit l'un, soit l'autre.

Mais en tout état de cause, je ne comprends pas le dysfonctionnement que tu constates.
Pour la forme, installes-toi une machine virtuelle avec la config client et teste sur ton poste de dev.

Argy

[tAKAmAkA]

Merci argy,

Pour la simulation mon poste de dev n'ouvre pas la base si il n'y a pas le /runtime, et me dit qu'elle ne s'ouvrira que lorsque access sera en mode exécution, ou alors d'utiliser le /runtime.
Je vais creuser cela dès que je suis tranquille.

Connais-tu un équivalent à la fonction que te m'a transmise pour ouvrir un répertoire et non un fichier?

merci pour ton attention bienveillante.

[argyronet]

Pourquoi as-tu deux fonctions SelectFolder() dans ton code ?
Tu dois avoir une erreur de compilation...

Argy

[Jack78960]

Bonjour,
dans ton code sur la fonction "OuvrirUnFichier" il se pourrait que l'initialisation de ta structure "StructFile" ne soit pas complète ==> c'est peut-être ce qui perturbe certains environnements systèmes ou runtimes, et pas d'autres ==> voici les propriétés manquantes sur un exemple personnel

Code :

1
2
3
4
5
6
7
8
9
10
    .lpstrDefExt = DefExt$ 'lstrcpy(DefExt$, DefExt$)
    .hInstance = 0
    .lpstrCustomFilter = 0
    .nMaxCustFilter = 0
    .lpstrInitialDir = szCurDir$ 'lstrcpy(szCurDir$, szCurDir$)
    .nFileOffset = 0
    .nFileExtension = 0
    .lCustData = 0
    .lpfnHook = 0
    .lpTemplateName = 0

Bien sur , ce n'est qu'un axe de recherche , mais j'ai déjà eu des dysfonctionnement du même genre avant d'avoir pu régler comdlg32.dll

Attention !!! Je ne suis pas sûr que FileDialog soit présent en access 2000 (à partir de 2002 seulement)

je te fournis le code complet de mon exemple, qui fonctionne depuis Access 2.0 (sur commdlg.dll à l'époque)

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
49
50
51
52
53
54
55
Function fenetreFichierOuvrir(cTitre As String, szCurDir$, meHwnd As Long, Optional filter$ = "") As String
    Dim Message$, FileName As String, FileTitle As String, DefExt$
    Dim Title$, APIResults As Long
    Dim i As Integer, nIndice As Integer, nbLongMax As Long
    Dim Jump_OPENFILENAME As OPENFILENAME
 
    nbLongMax = 255
    ' Type de fichier
    If filter$ = "" Then filter$ = "Document Word (*.DOC)" & Chr$(0) & "*.DOC" & Chr$(0)
    filter$ = filter$ & Chr$(0)
    FileName = Space$(254) & Chr$(0) & Chr$(0) '* Allocate string space for the returned strings.
    FileTitle = Space$(254) & Chr$(0) & Chr$(0)
    DefExt$ = "DOC" & Chr$(0) '* If the user does not specify an extension, append MDB.
    szCurDir$ = szCurDir$ & Chr$(0) '* Set up the default directory
 
    If cTitre <> "" Then '* Give the dialog a caption title.
      Title$ = cTitre & Chr$(0)
    Else
      Title$ = "Enregistrer sous" & Chr$(0)
    End If
    '* Set up the data structure before you call the GetOpenFileName
    Jump_OPENFILENAME.lStructSize = Len(Jump_OPENFILENAME)
    Jump_OPENFILENAME.hwndOwner = meHwnd  'GetActiveWindow()
    Jump_OPENFILENAME.lpstrFilter = filter$ 'lstrcpy(Filter$, Filter$)
    Jump_OPENFILENAME.nFilterIndex = 1
    Jump_OPENFILENAME.lpstrFile = FileName 'lstrcpy(FileName$, FileName$)
    Jump_OPENFILENAME.nMaxFile = nbLongMax
    Jump_OPENFILENAME.lpstrFileTitle = FileTitle$ 'lstrcpy(FileTitle$, FileTitle$)
    Jump_OPENFILENAME.nMaxFileTitle = nbLongMax
    Jump_OPENFILENAME.lpstrTitle = Title$ 'lstrcpy(Title$, Title$)
    Jump_OPENFILENAME.flags = OFN_EXPLORER Or OFN_ENABLEHOOK
    Jump_OPENFILENAME.lpstrDefExt = DefExt$ 'lstrcpy(DefExt$, DefExt$)
    Jump_OPENFILENAME.hInstance = 0
    Jump_OPENFILENAME.lpstrCustomFilter = 0
    Jump_OPENFILENAME.nMaxCustFilter = 0
    Jump_OPENFILENAME.lpstrInitialDir = szCurDir$ 'lstrcpy(szCurDir$, szCurDir$)
    Jump_OPENFILENAME.nFileOffset = 0
    Jump_OPENFILENAME.nFileExtension = 0
    Jump_OPENFILENAME.lCustData = 0
    Jump_OPENFILENAME.lpfnHook = 0
    Jump_OPENFILENAME.lpTemplateName = 0
    APIResults = GetOpenFileName(Jump_OPENFILENAME)
    If APIResults <> 0 Then
        FileName = Jump_OPENFILENAME.lpstrFile
        FileTitle = Jump_OPENFILENAME.lpstrFileTitle
        fenetreFichierOuvrir = Left$(FileName, InStr(1, FileName, Chr$(0)) - 1)
        On Error Resume Next
        If Dir$(fenetreFichierOuvrir) = "" Then
            fenetreFichierOuvrir = ""
        End If
    Else
        fenetreFichierOuvrir = ""
    End If
    On Error GoTo 0
End Function

Si cela marche, applique la même technique pour l'extraction des répertoire

[tAKAmAkA]

Je n'ai eu que 3/4 d'heures pour investiguer chez le client.

La fonction d'argy OuvrirDialogueFichier fonctionne à merveille!
Si ça n'avait pas marché j'avais prévu un repli avec une input box mais c'est quand même moins ergonomique!

Cela ne m'explique pas pourquoi GetOpenFileName ne fonctionne pas.
J'ai supprimé les commentaires que j'avais idiotement mis mais ça n'a rien changé.
Je vais donc suivre les conseils de Jack, quitte à planquer un bouton dans un coin pour tester ça chez le client.

argy:

Pourquoi as-tu deux fonctions SelectFolder() dans ton code ?

Désolé, j'ai dû sucrer les fraises sur Ctrl V! Il n'y en a bien qu'une.
Connais-tu l'équivalent de OuvrirDialogueFichier pour un répertoire? ou peut-être est-ce adaptable...

D'autre part je m'attends à d'autres dysfonctionnements, les tests que j'ai eu le temps de faire ne sont pas encourrageants.
Le poste n'a que 248Mo de mémoire. Cela peut-il influencer l'exécution du programme?

[Jack78960]

Cadeau Pièce jointe 23887 pour attraper un repertoire

[tAKAmAkA]

Merci,
C'est du lourd...
Ca va me prendre au moins la nuit de lire tout ça.
Je vais prendre pour l'instand ce qui m'interresse.
Le module reg32 est-il nécessaire?

[argyronet]

Envoyé par tAKAmAkA

Cela ne m'explique pas pourquoi GetOpenFileName ne fonctionne pas.
J'ai supprimé les commentaires que j'avais idiotement mis mais ça n'a rien changé.
Je vais donc suivre les conseils de Jack, quitte à planquer un bouton dans un coin pour tester ça chez le client.

argyésolé, j'ai dû sucrer les fraises sur Ctrl V! Il n'y en a bien qu'une.

Dans mon ouvrage Access 2007, BrowseForFolder()et GetOpenFileName() sont exploités avec succès.
Je pense que tu as une omission quelque part.

Argy

[tAKAmAkA]

Je l'ai commandé.
Et Hop! dans le goret!
(14€ de frais de port... c'est dur d'habiter loin...)
Peut-être un après lecture!

[argyronet]

Oui, mais c'est parce qu'il regorge de bons trucs, donc le poids en prend un coup !

C'est où loin ?

Argy

[naphta]

J'ai obtenu le même genre de problème avec un démarrage de frontal qui vérifie au démarrage les liaisons de tables.
Après l'installation le frontal appel le sélecteur de répertoire pour établir les liaisons et ça tourne dans le vide.
Sur cette machine XP SP2 un ancien runtime 2003 enlevé au couteau dans la base de registre et des résidus d'office 2000.
Ca c'est fini par la réinstallation du poste.

PS: Il y a un nouveau PDFCreator qui tourne sur Vista

[tAKAmAkA]

argy:

c'est parce qu'il regorge de bons trucs

je n'en doute pas, c'est pour ça que j'ai cassé ma tire-lire; si j'amais ça a été expédié par chronopost la douane va l'ouvrir, me faire payer 2 euros de taxes plus 9 euros de frais de dossier (pour le coup de cutter) et me dire de venir le chercher à leur bureau de l'aéroport (50 km AR).
Tu vois que la maison ne recule devant aucun sacrifice.

Loin c'est en Guadeloupe, un beau pays si il n'y avait pas de douaniers!

naphta: merci pour le tuyau, ça ressemble à mon cas de figure.

Pour PDFCreator c'est un super bonne nouvelle!

[tAKAmAkA]

Il y a effectivement plein de bons trucs mais

Dans mon ouvrage Access 2007, BrowseForFolder()et GetOpenFileName() sont exploités avec succès.
Je pense que tu as une omission quelque part.

je ne trouve pas trace de BrowseForFolder()!
Peux-tu m'orienter stp?

[naphta]

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
Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
 
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
 
Private Const BIF_RETURNONLYFSDIRS = &H1
 
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
 
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
 
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
 
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

Cette fonction "fonctionne" et retourne un chemin sélectionné (chez moi avec runtime 2007 SP1)
Je ne sais pas si c'est cela que tu cherches ?
Fonction trouvée quelque part ...
A+

[tAKAmAkA]

Merci naphta,

Ca marche sur mes postes yc Runtime.
Reste à tester chez le client!
Quelques petites diff avec ce que j'ai déjà. On verra bien!

[argyronet]

Ooops...
Tu as raison, il me semblait pourtant mais il n'y a pas grand chose à faire pour obtenir cela :

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
 
 
Private Function SelectionnerDossier(ByVal DossierRacine As String) As String
''''-------------------------------------------------------------------
'''' Permet d'afficher la boîte de dialogue Ouvrir avec la liste des dossier
''''-------------------------------------------------------------------
 
'''' Déclaration d'un objet FileDialog pour la boîte de dialogue Ouvrir
''''(Faire référence à Microsoft Office 12)
Dim oFDLG As FileDialog
Dim strNomDossier As String
 
  ''''Paramètres la boîte de dialogue Ouvrir
  Set oFDLG = Application.FileDialog(msoFileDialogFolderPicker)
  With oFDLG
      '''' Affectation d'un titre
      .Title = "Sélectionner un dossier"
      '''' Ouvre l'explorateur dans le dossier 'Mes documents'
      .InitialFileName = DossierRacine
      '''' Empêche la sélection multiple de dossiers
      .AllowMultiSelect = False
      '''' Définition du mode de visu en liste
      .InitialView = msoFileDialogViewList
      '''' Affecte la légende du bouton
      .ButtonName = "Choisir ce dossier"
 
      ''''Affiche la fenêtre avec gestion d'erreur
      On Error GoTo SelectionAnnulee
      .Show
      '''' Affecte le fichier image à la variable
       strNomDossier = .SelectedItems(1)
  End With
 
SortieDossier:
  SelectionnerDossier = strNomDossier
  Set oFDLG = Nothing
  Exit Function
SelectionAnnulee:
MsgBox Error, , err
  MsgBox "Erreur durant la sélection du dossier" & vbCrLf & _
  err.Description, , "Erreur n°" & err.Number
  strNomDossier = DossierRacine
  Resume SortieDossier
End Function

Tu l'utilises alors ainsi :

Code :

1
2
3
4
5
 
Private Sub cmdObtenirDossier_Click()
  MsgBox _
      SelectionnerDossier("C:\Documents and Settings\argyronet\Mes documents\")
End Sub

C'est présenté de façon différente mais autrement + simple à coder...

En fait, c'est dans l'application Pictothèque de l'ouvrage que cette fonction devait figurer mais j'ai du peut-être me raviser au dernier moment.

Ceci dit, les codes source des BrowseFolder() qui t'on été fourni durant ces différents posts sont opérationnels (§ Jack78960 & naphta)

Argy

[tAKAmAkA]

Merci beaucoup Argy,

Je sens que cela va me tirer d'affaire, débloquer la situation et me permettre d'analyser plus sereinement pourquoi j'ai un problème avec GetOpenFileName.
C'est exactement ce qu'il me fallait!
Je pense que j'ai un problème de fond, de code pas "propre" qui n'est pas toléré en mde et en runtime. Je vais travailler là-dessus.
A bientôt pour le tag .
aussi à naphta et jack78960, vos codes sont "sous bouton", prêts à être éxécutés!