XL 2019 Exécuter une procédure à une heure définie (plannification)

Data Enthousiast · 4 Juin 2021

Bonjour,
Je suis débutant en VBA , et je suis confronté à un problème qui consiste de cliquer une seule fois sur un bouton créé dans une feuille d'excel pour exécuter une procédure chaque matin à 9h , cette procédure permet d'exporter les données (valeurs) du jour précédent lorsque la base de données de l'entreprise est mise à jour.

J'ai mis en place un code qui permet si nous sommes lundi d'exporter les données du vendredi de la semaine précédente ( en ignorant le samedi et le dimanche), si nous sommes mardi ou mercredi ou jeudi ou vendredi d'exporter les données du jour précédent de la semaine en cours , et si nous sommes le weekend de ne rien faire .

Mon problème est que le code que j'ai mis en place, marche que pour un seul jour et ne marche pas pour les jours suivants après avoir cliquer sur le bouton dans le fichier excel associé au code.

Je souhaiterais que lorsque je clique sur le bouton une seule fois que la procédure s'exécute chaque matin(9h) tout les jours de la semaine ( du lundi au vendredi ) sans avoir besoin de nouveau cliquer sur le bouton.

Svp Est-ce qu'il y aurait une personne ayant été confrontée à de tel problème pour m'aider ?

Ci-dessous mon code :

VB:

'Exportation du fichier Nova chaque matin à 8h

Public Sub Robot()

Dim mydate As Date
Dim wsOIL_Spot As Worksheet
Dim wsFX_Spot As Worksheet
Dim lastOILSpotDate As Date
Dim lastFXSpotDate As Date
Dim lastNovaExportDate As Date
Dim exported As Boolean

    exported = False
    
    Set wsOIL_Spot = ThisWorkbook.Sheets("OIL_Spot")
    Set wsFX_Spot = ThisWorkbook.Sheets("FX_Spot")
  
    mydate = Date
    
    If Weekday(mydate, vbMonday) = 1 Then  ' si nous sommes lundi
        mydate = Date - 3 '  gestion weeckend , si lundi, exporter les données du vendredi précédent
      
      Else
      
        mydate = Date - 1
        
    End If
    
    lastOILSpotDate = CDate(mydate)
    lastFXSpotDate = CDate(mydate)
    
    lastNovaExportDate = IIf(Weekday(mydate, vbMonday) = 1, CDate(mydate) - 3, CDate(mydate) - 1)




'Gérer les week ends. 6 is saturday and 7 is sunday

    If Weekday(mydate) = 1 Or Weekday(mydate) = 2 Or Weekday(mydate) = 3 Or Weekday(mydate) = 4 Or Weekday(mydate) = 5 Then
    
        Application.OnTime TimeValue("09:00:00"), "Procédure_Export"      'lundi
        
        Application.Wait TimeValue("00:00:05")
        
        
        Application.OnTime TimeValue("09:00:00"), "Procédure_Export"         'mardi
        
         Application.Wait TimeValue("00:00:05")
        
        
        Application.OnTime TimeValue("09:00:00"), "Procédure_Export"    'Mercredi
         Application.Wait TimeValue("00:00:05")
        
        
        Application.OnTime TimeValue("09:00:00"), "Procédure_Export"   'Jeudi
        
         Application.Wait TimeValue("00:00:05")
        
        
        Application.OnTime TimeValue("09:00:00"), "Procédure_Export"   Vendredi
        

    End If
    

End Sub

patricktoulon · 4 Juin 2021

et moi 2013 sur W7

dysorthographie · 4 Juin 2021

copie colle Debug.Print "SchTasks /delete /Tn """ & strTaskName & """ /F" dans une fenêtre CMD

patricktoulon · 4 Juin 2021

re
et oui je soupconne le mode administrateur

patricktoulon · 4 Juin 2021

quand j’exécute cmd en administrateur

dysorthographie · 4 Juin 2021

écris ça SchTasks /delete /? dans une fenetre DOS

patricktoulon · 4 Juin 2021

re
je sais que l'on peut lancer cmd.exe +la commande en mode administrateur
tu peux me rappeler comment parce que là avec schtaks je vois pas

dysorthographie · 4 Juin 2021

deux possibilités!

Code:

Shell ("runas user:<NomOrdinateurLocal>\Administrateur C:\Windows\System32\cmd.exe")

ou encapsuler tout ton code dans un session admin!

Code:

#If VBA7 Then
    Declare PtrSafe Function LogonUser Lib "advapi32" Alias "LogonUserA" (ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken As Long) As Long
    Declare PtrSafe Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal hToken As Long) As Long
    Declare PtrSafe Function RevertToSelf Lib "advapi32.dll" () As Long
#Else
    Public Declare Function LogonUser Lib "advapi32" Alias "LogonUserA" (ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken As Long) As Long
    Declare Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal hToken As Long) As Long
    Declare Function RevertToSelf Lib "advapi32.dll" () As Long
#End If
Enum MConst
    LOGON32_LOGON_INTERACTIVE = 2
    LOGON32_PROVIDER_DEFAULT = 0
End Enum
Public lngTokenHandle, lngLogonType, lngLogonProvider As Long
Public blnResult As Boolean
 
 
Sub TEST()
 If AdminLogOn("Username", "Domain", "Password") Then
    Shell "C:\Windows\System32\calc.exe"
    Shell "C:\Windows\system32\notepad.exe"
 Logoff
 End If
End Sub

Public Function AdminLogOn(Username, Domain, Password) As Boolean
blnResult = RevertToSelf()
If LogonUser( _
Username, _
Domain, _
Password, _
          LOGON32_LOGON_INTERACTIVE, _
         LOGON32_PROVIDER_DEFAULT, _
            lngTokenHandle) = 0 Then
    MsgBox "Impossible d'ouvrir la session : " & Username & ". "
    GoTo Fin
End If
If blnResult = False Then
    MsgBox "Impossible d'ouvrir LogonUser"
   GoTo Fin
End If
blnResult = ImpersonateLoggedOnUser(lngTokenHandle)
AdminLogOn = True: Exit Function
Fin:
AdminLogOn = False
End Function
Public Sub Logoff()
Dim blnResult As Boolean
'MsgBox "Session fermée"
blnResult = RevertToSelf()
End Sub

regardes quand même les option de SchTasks /delete /? tu peux l'exécuter en admin!

patricktoulon · 5 Juin 2021

re
Bonjour Robert
ça fait mutch tout ça
j'avais un truc plus simple mais je ne m'en souviens plus et je ne le retrouve pas non plus

dysorthographie · 5 Juin 2021

bonjour Patrick,
je pense qu'un truc com ça fonctionne!

Runas

docs.microsoft.com

VB:

Shell ("runas user:<NomOrdinateurLocal>\Administrateur  SchTasks /delete /Tn """ & strTaskName & """ /F")

patricktoulon · 5 Juin 2021

re
Ahh... ça ressemble plus à ce que j'avais déjà

patricktoulon · 5 Juin 2021

RE
bon ben j'ai testé et NADA!!!

VB:

Sub DeleteTask()
 nomtache = "job"    ' nom de la tache
'Shell ("runas user:<NomOrdinateurLocal>\Administrateur  SchTasks /delete /Tn """ & strTaskName & """ /F")
Shell ("runas user:<Patrick>\Administrateur  SchTasks /delete /Tn """ & nomtache & """ /F")
Shell ("runas user:<polux>\Administrateur  SchTasks /delete /Tn """ & nomtache & """ /F")
Shell ("runas user:<polux>\polux  SchTasks /delete /Tn """ & nomtache & """ /F")
Shell ("runas user:<polux>\patrick  SchTasks /delete /Tn """ & nomtache & """ /F")
Shell ("runas user:polux\polux  SchTasks /delete /Tn """ & nomtache & """ /F")
Shell ("runas user:polux\patrick  SchTasks /delete /Tn """ & nomtache & """ /F")
End Sub

Pas moyen de la supprimer

XL 2019 Exécuter une procédure à une heure définie (plannification)

Data Enthousiast

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

Runas

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires