Problème avec boîte de dialogue

**zorely** · 06/02/2008, 11h51

Bonjour à tous,

J'ai créé une appli sous Access dans laquelle je réalise un export d'une requête vers un fichier Excel à l'aide des explications fournis: Afficher la boîte de dialogue Enregistrer sous afin de récupérer le nom et le chemin du fichier sélectionné à la page . Je n'ai pas eu de difficultés particulières.
Depuis j'ai sécurisé ma base access et je n'arrive plus à faire mon export, et je n'ai aucun message d'erreur.
Je vous met le code ci dessous

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
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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
        Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) _
        As Long
 
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
 
Private Sub Export_Click()
On Error GoTo Err_Export_Click
 
    Dim qdf As DAO.QueryDef
    Dim rcs As DAO.Recordset
    Dim chn As String
    Dim dlgSaveAs As FileDialog
 
    If Me.listeNom.Value <> "" Or Me.listeNom.Value <> " " Then
        'On récupère tous les enregsitrements sans filtre
        chn = "SELECT [Table PRE-SYNTHESE_CONSOMME].societe AS Société, [Table PRE-SYNTHESE_CONSOMME].nom AS Nom, [Table PRE-SYNTHESE_CONSOMME].codeDO AS DO, [Table PRE-SYNTHESE_CONSOMME].codeCCD AS Type, [Table PRE-SYNTHESE_CONSOMME].lotposte AS [Lot Poste], [Table PRE-SYNTHESE_CONSOMME].lieu AS Lieu, [Table PRE-SYNTHESE_CONSOMME].prodsociete AS Prod, [Table PRE-SYNTHESE_CONSOMME].delta AS Régul, [Table PRE-SYNTHESE_CONSOMME].fact AS Fact, [Table PRE-SYNTHESE_CONSOMME].commentaire AS Commentaire FROM [Table PRE-SYNTHESE_CONSOMME] WHERE (resp=" + "'" + Me.listeNom.Value + "')"
 
        If Me.CheckValidation.Value = True Then
            'Seulement les enregistrements validés
            chn = chn & "AND  (validation <>'' OR validation <>' ')"
        End If
        If (Me.ListeProjet.Value <> " " Or Me.ListeProjet.Value <> "") Then
            'le RA + le projet de la liste
            chn = chn & " AND (projet='" & Me.ListeProjet.Value & "')"
        End If
 
        If (Me.ListeRessource.Value <> " " Or Me.ListeRessource.Value <> "") Then
            'le RA + le projet de la liste + la ressource de la liste
            chn = chn & " AND (nom='" & Me.ListeRessource.Value & "')"
        End If
 
        Set qdf = CurrentDb.QueryDefs("R EXPORT Excel")
        qdf.SQL = chn
        'Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs)
        Chemin = EnregistrerUnFichier(Me.hWnd, "Enregistrer sous", "Export.xls", "C:\")
        'dlgSaveAs.Show
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "R EXPORT Excel", Chemin, True
    Else
        MsgBox "Vous devez choisir un reponsable d'activité"
    End If
 
Exit_Export_Click:
    Exit Sub
 
Err_Export_Click:
    MsgBox Err.Description
    Resume Exit_Export_Click
 
 
End Sub
 
Function EnregistrerUnFichier(Handle As Long, Titre As String, _
                    NomFichier As String, Chemin As String) As String
 
 'EnregistrerUnFichier est la fonction a utiliser dans votre formulaire pour ouvrir _
la boîte de dialogue d'enregistrement d'un fichier.
 'Explication des paramètres
    'Handle = le handle de la fenêtre (Me.Hwnd)
    'Titre = Titre de la boîte de dialogue
    'NomFichier = Nom par défaut du fichier à enregistrer
    'Chemin = Chemin par défaut du fichier à enregistrer
 
Dim structSave As OPENFILENAME
 
With structSave
    .lStructSize = Len(structSave)
    .hWndOwner = Handle
    .nMaxFile = 255
    .lpstrFile = NomFichier & String$(255 - Len(NomFichier), 0)
    .lpstrInitialDir = Chemin
    .lpstrFilter = "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0) 'Définition du filtre (aucun)
    .Flags = &H4  'Option de la boite de dialogue
End With
 
If (GetSaveFileName(structSave)) Then
    EnregistrerUnFichier = Mid$(structSave.lpstrFile, 1, InStr(1, structSave.lpstrFile, vbNullChar) - 1)
End If
 
End Function