Discussion :

[fourmidiable]

Hello,
Je dévelloppe une petite application en excel VBA, et je dois garantir la date utilisée. Je peux pas me fier à la date du PC et je dois donc récupérer la date sur un serveur sntp ou ntp, ou m'assurer que la synchronisation du PC aie été faîtes avant le début de l'application.
Ca fait 1 mois que j'essaie diverses solution et j'ai pas réussi.

• 1ère solution: Envoyer une requête sur un serveur ntp ou SNTP et récupérer les informations.
• 2ème solution: Ordonner à windows de se synchroniser au serveur SNTP, avant le déroulement de l'application.

Auriez-vous des pistes pour m'aider?.

Configuration: Windows 2000; office 2000 SP3.


Merci de votre aide.

David

PS: Je ne peux pas me fier à l'heure du PC car pour des raisons "débiles" il est possible que l'utilisateur final change la date....

Raison pour

[fourmidiable]

Alors j'ai trouvé une solution et je vous la communique. J'ouvre une fenêtre DOS cachée (hide) et je met à jour l'heure du PC avec la fonction net time en indiquant le serveur qui me servira de référence (XXXXXXXX).

De plus on attend que la mise à jour soit faîte avant que la macro continue.


Dans la feuille:

Code :

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

1
2
 
ShellWait "Cmd /c net time \\rndusexjnjdc1 /set /y"

Dans un module:

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
 
'Wait shell
 
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long
 
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, vbHide))
    Do
        GetExitCodeProcess hProcess, RetVal
        DoEvents
        Sleep 100
    Loop While RetVal = STILL_ACTIVE
End Sub