Discussion :

[Fringe]

Bonjour à tous,
J'ai besoin de votre aide s'il vous plaît:
j'ai un tableau dans une BD (Tableau 1) avec des informations sur des dossiers juridiques et des liens qui renvoient à ces dossiers (dossierA) .
Ces dossiers sont mis à jour, il faut donc déplacer les anciens dossiers dans un nouveau fichier d'archivage (dossierA --> dossierB).
Il est demandé de garder un genre d'historisation de ses données, de mettre à jour les liens vers les dossiers (Tableau 2) et d'ajouter automatiquement la date d'archivage.

Serait-il possible de faire ça automatiquement par un ou quelque bouton dans Access 2013 ?

Tableau 1

id	no	nuf	titre	url
1	256523	6755	plan	http://portail.x.yy/dossierA/123.pdf
2	125478	6253	groupe	http://portail.x.yy/dossierA/456.pdf

Tableau 2

id	no	nuf	titre	url	DateArchive
1	256523	6755	plan	http://portail.x.yy/dossierB/123_archive.pdf	16112014
2	125478	6253	groupe	http://portail.x.yy/dossierB/456_archive.pdf	10102014

J'espère que j'étais assez clair.

Je vous remercie d'avance pour vos idées et avis.

[User]

Bonsoir,

Si on suppose que "Tableau 1" et "tableau 2" désigne 2 tables Access ayant comme identifiant (clé primaire) le champ "id", alors il faudrait mettre ce code VBA sur un bouton "CmdArchiver" :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub CmdArchiver_Click()
Dim leSQL As String
 
leSQL = "INSERT INTO [Tableau 2] ( id, [no], nuf, titre, url, DateArchive ) " & _
"SELECT [Tableau 1].id, [Tableau 1].[no], [Tableau 1].nuf, [Tableau 1].titre, [Tableau 1].url, Date() AS Expr1 " & _
"FROM [Tableau 1]" & _
"WHERE ((([Tableau 1].id) Not In (select id from [Tableau 2])));"
 
DoCmd.SetWarnings False
DoCmd.RunSQL leSQL ' exécution de la requête.
DoCmd.SetWarnings True
 
End Sub

Ce code archive les lignes présentes dans "tableau 1" mais pas dans "tableau 2", en se basant sur l'identifiant "id".

Bonne continuation,
Cdlt,

[Fringe]

Bonjour,

Merci beaucoup pour votre réponse.

En fait, le "Tableau 1" regroupe 450 lignes qu'on peut les visualiser en détail sous un formulaire de sélection.
Il me faut donc juste archiver ma sélection et non pas le tableau en entier.

De plus, le lien URL dans Tableau 1 renvoie à un document PDF stocker dans Dossier A.

Serait-il possible de déplacer le document PDF d'un Dossier A vers un Dossier B, de modifier son nom et de mettre à jour le lien URL dans Tableau 2 ?

Merci d'avance.
Meilleures salutations.

[User]

Bonjour,

Je vous joins un exemple calqué sur votre méthode d'archivage.

Le code qui vous intéresse, placé sur l'événement clic du bouton CmdArchiver est celui-ci :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub CmdArchiver_Click()
Dim leSQL As String
 
leSQL = "INSERT INTO [Tableau 2] ( id, [no], nuf, titre, url, DateArchive ) " & _
"SELECT [Tableau 1].id, [Tableau 1].[no], [Tableau 1].nuf, [Tableau 1].titre, Replace([Tableau 1].url,'dossierA','dossierB') as doc, Date() AS Expr1 " & _
"FROM [Tableau 1]" & _
"WHERE (([Tableau 1].id) Not In (select id from [Tableau 2])) and titre like '" & Nz(Me.ParamTitre, "*") & "';"
 
DoCmd.SetWarnings False
DoCmd.RunSQL leSQL
DoCmd.SetWarnings True
 
End Sub

Revenez avec vos questions concernant ce code.

Par exemple, il vous faudra surement placer votre critère de sélection des données au niveau du Where :

Code :

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

"WHERE (([Tableau 1].id) Not In (select id from [Tableau 2])) and titre like '" & Nz(Me.ParamTitre, "*") & "';"

Cdlt,

[Fringe]

Bonjour,

Merci pour votre réponse.

Le schéma suivant permettra de décrire un peu l'interface de ma BD.

Un bouton dans le formulaire général permet d'envoyer au formulaire détaillé et c'est dans celui ci que je veux ajouter le bouton "CmdArchiver"



Reste à savoir si c'est possible de déplacer le PDF d'un fichier à un autre:
exemple: le document 123.pdf existe dans un fichier A je veux le déplacer dans un fichier B.

Merci encore et bonne soirée.
Meilleures salutations

[User]

Bonsoir,

Dans le cas simple de fichier sur le disque j'aurais cette solution :

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
 
Private Sub CmdArchiver_Click()
Dim leSQL As String
Dim fso As Object
Dim source As String, destination As String
 
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
 
leSQL = "INSERT INTO [Tableau 2] ( id, [no], nuf, titre, url, DateArchive ) " & _
"SELECT [Tableau 1].id, [Tableau 1].[no], [Tableau 1].nuf, [Tableau 1].titre, Replace([Tableau 1].url,'dossierA','dossierB') as doc, Date() AS Expr1 " & _
"FROM [Tableau 1]" & _
"WHERE (([Tableau 1].id) Not In (select id from [Tableau 2])) and id = " & Nz(Me.id, 0) & ";"
 
DoCmd.SetWarnings False
DoCmd.RunSQL leSQL
DoCmd.SetWarnings True
 
source = Mid(Me.url.Value, 2, Len(Me.url) - 2)
destination = Replace(source, "DossierA", "DossierB")
 
Call fso.CopyFile(source, destination)
 
End Sub

Par contre pour des fichiers hébergés sur des serveurs web, c'est plus compliqué :

Je pense qu'il faut faire un téléchargement du fichier source sur le disque, pour ensuite le transférer en utilisant le protocole ftp.
Il y a de nombreux exemples en VBA sur le net et dans les sources.

Cdlt,

[Fringe]

Bonjour,
Merci encore pour votre réponse.
J'ai ce message d'erreur qui s'affiche:




J'ai essayé de lancer juste la partie archivage (code suivant)

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
 
Private Sub CmdArchiver_Click()
 
Dim leSQL As String
'Dim fso As Object
'Dim source As String, destination As String
 
leSQL = "INSERT INTO [crdppf_documents_edition_archive] ( idobj, nocom, nufeco, nocad, nomcom, nomcomsansaccent, titre, abreviationtitre, titreofficiel, abreviation, noplanspecial, noofficiel, url, urlbase, statutjuridique, datesanction, dateabrogation, operateursaisie, datesaisie, canton, doctype, topicfk, rccunic, dateheurearchive, Idunic) " & _
"SELECT [crdppf_documents_edition].idobj, [crdppf_documents_edition].nocom, [crdppf_documents_edition].nufeco, [crdppf_documents_edition].nocad, [crdppf_documents_edition].nomcom, [crdppf_documents_edition].nomcomsansaccent, [crdppf_documents_edition].titre, [crdppf_documents_edition].abreviationtitre, [crdppf_documents_edition].titreofficiel, [crdppf_documents_edition].abreviation, [crdppf_documents_edition].noplanspecial, [crdppf_documents_edition].noofficiel, Replace([crdppf_documents_edition].url,'PS','PS_archive'), [crdppf_documents_edition].urlbase, [crdppf_documents_edition].statutjuridique, [crdppf_documents_edition].datesanction, [crdppf_documents_edition].dateabrogation, [crdppf_documents_edition].operateursaisie, [crdppf_documents_edition].datesaisie, [crdppf_documents_edition].canton, [crdppf_documents_edition].doctype, [crdppf_documents_edition].topicfk, [crdppf_documents_edition].rccunic, Now() AS Expr1, [crdppf_documents_edition].noofficiel & Now()" & _
"FROM [crdppf_documents_edition]" & _
"WHERE (([crdppf_documents_edition].idobj Not In (select idobj from [crdppf_documents_edition_archive])) and idobj = " & Nz(Me.idobj, 0) & ";"
 
 
DoCmd.SetWarnings False
DoCmd.RunSQL leSQL 'exécution de la requête.
DoCmd.SetWarnings True
 
'source = Mid(Me.url.Value, 2, Len(Me.url) - 2)
'destination = Replace(source, "PS", "PS_archive")
 
'Call fso.CopyFile(source, destination)
 
End Sub

Et j'ai ce message d'erreur:



Est-ce qu'il manque quelques choses à votre avis?

Merci encore et bonne journée

Meilleures salutations

[User]

Bonjour,

Votre formulaire détail est-il basé sur la table "tableau 1", la table ou la requête source de ce formulaire devrait avoir le champ url ?
Sinon, je crois que cela correspond à votre champ "Url de la disposition juridique.

Quand dans le code vous préfixez avec Me., normalement vous devez avoir une liste de propriétés qui apparaissent qui correspondent aux propriétés de votre formulaire "Détail", y compris les noms des champs.

Concernant l'erreur de synthaxe, il doit manquer une virgule :

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
Private Sub CmdArchiver_Click()
 
Dim leSQL As String
'Dim fso As Object
'Dim source As String, destination As String
 
leSQL = "INSERT INTO [crdppf_documents_edition_archive] ( idobj, nocom, nufeco, nocad, nomcom, nomcomsansaccent, titre, abreviationtitre, titreofficiel, abreviation, noplanspecial, noofficiel, url, urlbase, statutjuridique, datesanction, dateabrogation, operateursaisie, datesaisie, canton, doctype, topicfk, rccunic, dateheurearchive, Idunic) " & _
"SELECT [crdppf_documents_edition].idobj, [crdppf_documents_edition].nocom, [crdppf_documents_edition].nufeco, [crdppf_documents_edition].nocad, [crdppf_documents_edition].nomcom, [crdppf_documents_edition].nomcomsansaccent, [crdppf_documents_edition].titre, [crdppf_documents_edition].abreviationtitre, [crdppf_documents_edition].titreofficiel, [crdppf_documents_edition].abreviation, [crdppf_documents_edition].noplanspecial, [crdppf_documents_edition].noofficiel, Replace([crdppf_documents_edition].url,'PS','PS_archive'), [crdppf_documents_edition].urlbase, [crdppf_documents_edition].statutjuridique, [crdppf_documents_edition].datesanction, [crdppf_documents_edition].dateabrogation, [crdppf_documents_edition].operateursaisie, [crdppf_documents_edition].datesaisie, [crdppf_documents_edition].canton, [crdppf_documents_edition].doctype, [crdppf_documents_edition].topicfk, [crdppf_documents_edition].rccunic, Now() AS Expr1, [crdppf_documents_edition].noofficiel & Now()" & _
"FROM [crdppf_documents_edition]" & _
"WHERE (([crdppf_documents_edition].idobj) Not In (select idobj from [crdppf_documents_edition_archive])) and idobj = " & Nz(Me.idobj, 0) & ";"
 
 
DoCmd.SetWarnings False
DoCmd.RunSQL leSQL 'exécution de la requête.
DoCmd.SetWarnings True
 
'source = Mid(Me.url.Value, 2, Len(Me.url) - 2)
'destination = Replace(source, "PS", "PS_archive")
 
'Call fso.CopyFile(source, destination)
 
End Sub

Cdlt,

[Fringe]

Bonjour,
Merci beaucoup pour votre réponse, ça commence à prendre forme gentiment.
J'ai corrigé le nom de l'url, évidement ça ne faisait pas partie de la liste de propriétés.
J'ai créé un lien url provisoire pour faire le test (K:\RDPPF\Projet en cours\MI\Archive_BD_dispositions_juridiques\Buix_dj\PS\6777_4-1.pdf. Ce lien pointe sur un fichier en local. J'ai aussi créée les dossiers PS et PS_archive



J'ai maintenant ce message d'erreur:




Avez-vous des idées ?
Un dernier point, après archivage, le document doit être supprimé de la Table 1. Comment faire pour le supprimer?
Merci encore
Meilleures salutations

[User]

Re,

Pouvez-vous m'indiquer la ligne en jaune concernée par le message d'erreur ?

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
Private Sub CmdArchiver_Click()
 
Dim leSQL As String
Dim fso As Object
Dim source As String, destination As String
 
leSQL = "INSERT INTO [crdppf_documents_edition_archive] ( idobj, nocom, nufeco, nocad, nomcom, nomcomsansaccent, titre, abreviationtitre, titreofficiel, abreviation, noplanspecial, noofficiel, url, urlbase, statutjuridique, datesanction, dateabrogation, operateursaisie, datesaisie, canton, doctype, topicfk, rccunic, dateheurearchive, Idunic) " & _
"SELECT [crdppf_documents_edition].idobj, [crdppf_documents_edition].nocom, [crdppf_documents_edition].nufeco, [crdppf_documents_edition].nocad, [crdppf_documents_edition].nomcom, [crdppf_documents_edition].nomcomsansaccent, [crdppf_documents_edition].titre, [crdppf_documents_edition].abreviationtitre, [crdppf_documents_edition].titreofficiel, [crdppf_documents_edition].abreviation, [crdppf_documents_edition].noplanspecial, [crdppf_documents_edition].noofficiel, Replace([crdppf_documents_edition].url,'PS','PS_archive'), [crdppf_documents_edition].urlbase, [crdppf_documents_edition].statutjuridique, [crdppf_documents_edition].datesanction, [crdppf_documents_edition].dateabrogation, [crdppf_documents_edition].operateursaisie, [crdppf_documents_edition].datesaisie, [crdppf_documents_edition].canton, [crdppf_documents_edition].doctype, [crdppf_documents_edition].topicfk, [crdppf_documents_edition].rccunic, Now() AS Expr1, [crdppf_documents_edition].noofficiel & Now() " & _
"FROM [crdppf_documents_edition] " & _
"WHERE (([crdppf_documents_edition].idobj) Not In (select idobj from [crdppf_documents_edition_archive])) and idobj = " & Nz(Me.idobj, 0) & ";"
 
 
DoCmd.SetWarnings False
DoCmd.RunSQL leSQL 'exécution de la requête.
DoCmd.SetWarnings True
 
source = Mid(Me.legalprovisionurl, 2, Len(Me.legalprovisionurl) - 2)
destination = Replace(source, "PS", "PS_archive")
 
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
 
Call fso.CopyFile(source, destination)
 
' suppression de l'enregistrement archivé.
 
leSQL = "delete * from [crdppf_documents_edition_archive]  where idobj = " & Nz(Me.idobj, 0) & ";"
 
DoCmd.SetWarnings False
DoCmd.RunSQL leSQL 'exécution de la requête.
DoCmd.SetWarnings True
 
End Sub

Cdlt,

[micniv]

Bonjour ,

Fringe, c'est surement la déclaration du fso (File Object System) qui manque :

car pour pouvoir utiliser il faut ajouter la référence "Microsoft Scripting Runtime" au projet . Via Outils / references dans l'éditeur VBE

cordialement

[User]

Bonjour ,

Fringe, c'est surement la déclaration du fso (File Object System) qui manque :

car pour pouvoir utiliser il faut ajouter la référence "Microsoft Scripting Runtime" au projet . Via Outils / references dans l'éditeur VBE

cordialement

Salut micniv

Il me semble qu'ici on est dans du "Late Binding", la variable étant déclarée de type Object à priori on a pas besoin de référence.

Cdlt,

[micniv]

Bonjour User,

Autant pour moi si la déclaration de la référence n'est nécessaire (je ne suis pas trop fan des late bindings car il y souvent une limite à son utilisation),
cependant je ne vois pas la ligne de déclaration de l'objet fso : SET fso = CreateObject(...)

A+

[User]

En effet, elle a été égarée en chemin

Code :

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

1
2
 
Set fso = VBA.CreateObject("Scripting.FileSystemObject")

Cdlt,

[Fringe]

Bonjour,

Merci beaucoup pour vos réponses.

J'ai coché la référence que micniv a indiqué. J'ai maintenant le message d'erreur suivant sur la ligne encadré en jaune:



Merci encore et bonne soirée.
Meilleures salutations

[User]

Bonsoir,

Comme indiqué précédemment il est inutile de cocher la référence.

Pour votre message d'erreur, il faudrait voir les chemins contenus dans les variables source et destination :

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
Private Sub CmdArchiver_Click()
 
Dim leSQL As String
Dim fso As Object
Dim source As String, destination As String
 
leSQL = "INSERT INTO [crdppf_documents_edition_archive] ( idobj, nocom, nufeco, nocad, nomcom, nomcomsansaccent, titre, abreviationtitre, titreofficiel, abreviation, noplanspecial, noofficiel, url, urlbase, statutjuridique, datesanction, dateabrogation, operateursaisie, datesaisie, canton, doctype, topicfk, rccunic, dateheurearchive, Idunic) " & _
"SELECT [crdppf_documents_edition].idobj, [crdppf_documents_edition].nocom, [crdppf_documents_edition].nufeco, [crdppf_documents_edition].nocad, [crdppf_documents_edition].nomcom, [crdppf_documents_edition].nomcomsansaccent, [crdppf_documents_edition].titre, [crdppf_documents_edition].abreviationtitre, [crdppf_documents_edition].titreofficiel, [crdppf_documents_edition].abreviation, [crdppf_documents_edition].noplanspecial, [crdppf_documents_edition].noofficiel, Replace([crdppf_documents_edition].url,'PS','PS_archive'), [crdppf_documents_edition].urlbase, [crdppf_documents_edition].statutjuridique, [crdppf_documents_edition].datesanction, [crdppf_documents_edition].dateabrogation, [crdppf_documents_edition].operateursaisie, [crdppf_documents_edition].datesaisie, [crdppf_documents_edition].canton, [crdppf_documents_edition].doctype, [crdppf_documents_edition].topicfk, [crdppf_documents_edition].rccunic, Now() AS Expr1, [crdppf_documents_edition].noofficiel & Now() " & _
"FROM [crdppf_documents_edition] " & _
"WHERE (([crdppf_documents_edition].idobj) Not In (select idobj from [crdppf_documents_edition_archive])) and idobj = " & Nz(Me.idobj, 0) & ";"
 
 
DoCmd.SetWarnings False
DoCmd.RunSQL leSQL 'exécution de la requête.
DoCmd.SetWarnings True
 
source = Me.legalprovisionurl ' Mid(Me.legalprovisionurl, 2, Len(Me.legalprovisionurl) - 2)
destination = Replace(source, "\PS\", "\PS_archive\")
 
MsgBox (source) 'affiche la source dans une boîte de dialogue.
MsgBox (destination)  'affiche la destination dans une boîte de dialogue.
 
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
 
Call fso.CopyFile(source, destination)
 
' suppression de l'enregistrement archivé.
 
leSQL = "delete * from [crdppf_documents_edition_archive]  where idobj = " & Nz(Me.idobj, 0) & ";"
 
DoCmd.SetWarnings False
DoCmd.RunSQL leSQL 'exécution de la requête.
DoCmd.SetWarnings True
 
End Sub

Cdlt,

[Fringe]

Bonjour
Merci beaucoup pour votre réponse.
J'ai toujours le même message d'erreur sur la même ligne.
Par contre les MsgBox ont trouvé le bon emplacement :





C'est possible d'utiliser l'expression MoveFile au lieu de CopyFile ? parcequ'il faut que je déplace le fichier à PS_archive.

Merci encore et bonne journée
Meilleures salutations

[User]

Bonjour,

Vous avez le caractère (#) de chaque côté de la chaîne url, il faudrait essayer d'extraire uniquement l'adresse comme ceci :

Code :

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

1
2
3
4
5
source = Me.legalprovisionurl.Hyperlink.Address
destination = Replace(source, "\PS\", "\PS_archive\")
 
MsgBox (source) 'affiche la source dans une boîte de dialogue.
MsgBox (destination)  'affiche la destination dans une boîte de dialogue.

Pour le Movefile, vous pouvez l'essayer dans le code:

Code :

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

fso.Movefile(source, destination)

Ou faire :

Code :

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

1
2
fso.CopyFile(source, destination)
fso.DeleteFile source

Cdlt,

[Fringe]

Bonjour

Excellent travail merci beaucoup.

Une dernière question:

J'ai essayé d'ajouter un Format pour Now() qui correspond au dernier colonne de la table d'archive comme ceci:

[crdppf_documents_edition].noofficiel & (Format (Now(), "ddmmyyyyhhnnss")) mais ça n'a pas marché.

Avez-vous une idée ?

Merci d'avance et un grand merci pour tout.

Meilleures salutations

[User]

Merci,

Peut-être en remplaçant dans l'expression les guillemets (") par des quotes (') :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub CmdArchiver_Click()
 
Dim leSQL As String
Dim fso As Object
Dim source As String, destination As String
 
leSQL = "INSERT INTO [crdppf_documents_edition_archive] ( idobj, nocom, nufeco, nocad, nomcom, nomcomsansaccent, titre, abreviationtitre, titreofficiel, abreviation, noplanspecial, noofficiel, url, urlbase, statutjuridique, datesanction, dateabrogation, operateursaisie, datesaisie, canton, doctype, topicfk, rccunic, dateheurearchive, Idunic) " & _
"SELECT [crdppf_documents_edition].idobj, [crdppf_documents_edition].nocom, [crdppf_documents_edition].nufeco, [crdppf_documents_edition].nocad, [crdppf_documents_edition].nomcom, [crdppf_documents_edition].nomcomsansaccent, [crdppf_documents_edition].titre, [crdppf_documents_edition].abreviationtitre, [crdppf_documents_edition].titreofficiel, [crdppf_documents_edition].abreviation, [crdppf_documents_edition].noplanspecial, [crdppf_documents_edition].noofficiel, Replace([crdppf_documents_edition].url,'PS','PS_archive'), [crdppf_documents_edition].urlbase, [crdppf_documents_edition].statutjuridique, [crdppf_documents_edition].datesanction, [crdppf_documents_edition].dateabrogation, [crdppf_documents_edition].operateursaisie, [crdppf_documents_edition].datesaisie, [crdppf_documents_edition].canton, [crdppf_documents_edition].doctype, [crdppf_documents_edition].topicfk, [crdppf_documents_edition].rccunic, Now() AS Expr1, [crdppf_documents_edition].noofficiel & (Format (Now(), 'ddmmyyyyhhnnss')) " & _
"FROM [crdppf_documents_edition] " & _
"WHERE (([crdppf_documents_edition].idobj) Not In (select idobj from [crdppf_documents_edition_archive])) and idobj = " & Nz(Me.idobj, 0) & ";"
 ...

Cdlt,