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 |
Partager