Discussion :

[munity]

salut le phorum
voilà j'ai un problème avec ma BDD Access
si je suis en mode partagé,
j'ai ce message

Code :

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

microsof access ne peut pas enregistrer les modifications de conception ou effectuer un enregistrement dans un nouvel objet de base de données car le fichier est ouvert par un autre utilisateur. pour effectuer l'une ou l'autre opération, vous devez disposer d'un accès exclusif au fichir

quand je suis en mode exclusif et que je lance la macro il m'indique que la base est en cours d'utilisation et plante sur cette ligne

Code :

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

Set oDb = OpenDatabase(RepertoireBase & NomBase)

de plus dans la macro j'ai desactivé les setwarnings or il me mets tout de meme les alertes de création et suppression de données et tables

je me tire les cheveux depuis 3 jours je ne comprends pas j'ai déjà recrée la base 3 fois pensant à un problème de départ mais là j'avoue que je suis au bord de la crise de nerf

un peu d'aide me serait d'un grand secour

je mets la macro au cas ou il y aurait un problème de conception dans celle ci

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
102
103
104
105
106
107
108
109
110
111
112
113
 
 
Option Compare Database
Function RECUP_FICHIERS()
 
'Declaration de la valeur répertoire
Dim RepertoireBase As String, NomFichier As String, NomBase As String
Dim oDb As DAO.Database
 
'Recuperation de la liste des fichiers
RepertoireBase = Application.CurrentProject.Path & "\"
NomBase = Application.CurrentProject.Name
DoCmd.SetWarnings False
 
'Purge Table Principale
R001 = "DELETE * FROM IMPORTATION_RECAP"
DoCmd.RunSQL R001
 
If ExisteChamp("IMPORTATION_RECAP", "DOSSIER") = True Then
    CurrentDb.TableDefs("IMPORTATION_RECAP").Fields.Delete "DOSSIER"
End If
 
NomFichier = Dir(RepertoireBase & "Fichiers_Texte\*.txt", vbDirectory)
 
'On passe d'un fichier texte a l'autre
Do While NomFichier <> ""
'import des donnees du fichier excel dans Access
    DoCmd.TransferText acImportDelim, "IMPORTATION", "IMPORTATION_RECAP", RepertoireBase & "Fichiers_Texte\" & NomFichier, True
      NomFichier = Dir
Loop
 
'compter le nombre de magazins
R002 = "SELECT NumMagasin AS N_CLIENT INTO NOMBRE_MAGAZINS FROM IMPORTATION_RECAP GROUP BY NumMagasin ORDER BY IMPORTATION_RECAP.NumMagasin"
DoCmd.RunSQL R002
 
Set oDb = OpenDatabase(RepertoireBase & NomBase)
Set oTbl = oDb.TableDefs("IMPORTATION_RECAP")
'Etape 1 : Créer le champ
Set oFld1 = oTbl.CreateField("DOSSIER", dbText, 15)
oFld1.OrdinalPosition = 0
'Etape 3 : Ajout du champ à la table
oTbl.Fields.Append oFld1
'Rafraichit la collection
oTbl.Fields.Refresh
 
'oDb.Execute "DROP INDEX DOSSIER ON IMPORTATION_RECAP;"
'oDb.Close
 
 
 
I = CurrentDb.TableDefs("NOMBRE_MAGAZINS").RecordCount
 
'création du nom du dossier
NomBase = Application.CurrentProject.Name
NumeroDossier = Mid(NomBase, 3, 6)
 
'Création du numéro de lot
Set oDb = CurrentDb
Set oRst = oDb.OpenRecordset("Select N_CLIENT From NOMBRE_MAGAZINS order by N_CLIENT asc")
        If oRst.EOF = True Then oRst.MoveFirst
             While oRst.EOF = False
             For J = 1 To I
             DossierX = NumeroDossier & "_L" & Format(J, "00")
                 MAGAZINS = oRst.Fields(0).Value
                      DoCmd.SetWarnings False
                      DoCmd.RunSQL "UPDATE IMPORTATION_RECAP SET [DOSSIER] = '" & DossierX & "' " & "WHERE [NumMagasin] = '" & MAGAZINS & "';"
                      DoCmd.SetWarnings True
                 oRst.MoveNext
             Next J
            Wend
oRst.Close
oDb.Close
Set oRst = Nothing
Set oDb = Nothing
 
DoCmd.TransferSpreadsheet acImport, 10, "IMPORTATION_RECAP", RepertoireBase & "ADRESSES A AJOUTER + PIGES RESOS.xlsx", True, ""
 
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "TABLE_MAGAZIN_TRIES", Application.CurrentProject.Path & "\" & NomBase & ".xls"
 
R002 = "SELECT DOSSIER INTO LISTE_DOSSIER FROM IMPORTATION_RECAP GROUP BY DOSSIER ORDER BY DOSSIER"
DoCmd.RunSQL R002
 
'Création du fichier triade
Set oDb = CurrentDb
Set oRst = oDb.OpenRecordset("Select DOSSIER From LISTE_DOSSIER order by DOSSIER asc")
        If oRst.EOF = True Then oRst.MoveFirst
             While oRst.EOF = False
                LOT = oRst.Fields(0).Value
                         DoCmd.SetWarnings False
                         DoCmd.RunSQL "SELECT DOSSIER, [_Magasins_Rang], NumMagasin, Mag_Nom, Mag_Adrs1, Mag_Adrs2, Mag_Cp, Mag_Ville, CodeClient, TNP, CNom, CAdrs, " & _
                                    "Adrs, LieuDit, Cp, Ville, Pays, C_All_Rang, IdElfy, Libelle INTO LOT_TRIAD " & _
                                    "FROM IMPORTATION_RECAP " & _
                                    "WHERE DOSSIER= '" & LOT & "';"
                        DoCmd.TransferText acExportDelim, "EXPORT_TRIAD", "LOT_TRIAD", RepertoireBase & "Fichiers_Triade\" & LOT & ".txt", True, ""
                        DoCmd.SetWarnings True
                 oRst.MoveNext
            Wend
oRst.Close
oDb.Close
Set oRst = Nothing
Set oDb = Nothing
 
DoCmd.DeleteObject acTable, "NOMBRE_MAGAZINS"
DoCmd.DeleteObject acTable, "LISTE_DOSSIER"
DoCmd.DeleteObject acTable, "LOT_TRIAD"
 
'Purge Table Principale
R001 = "DELETE * FROM IMPORTATION_RECAP"
DoCmd.RunSQL R001
 
DoCmd.SetWarnings True
 
End Function

merci de votre aide

david

[munity]

bon j'ai réussi à régler mon problème
mauvais utilisation de l'instruction

Code :

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

Set oDb = OpenDatabase(RepertoireBase & NomBase)

il faut mettre

Code :

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

Set oDb = CurrentDb

et plus de plantage

pour les alertes j'ai rajouté un displayalerts avant les requêtes

ouf