Accueil
Accueil Le Club Delphi Kylix C C++ Java J2EE DotNET & C# Visual Basic Access Pascal Dev Web PHP ASP XML UML SQLSGBD Windows Linux Autres
logo

precedent    sommaire    suivant   


Comment créer une tâche planifiée Windows ?
auteur : SilkyRoad
Vba

'----------------------------------------------------
'Source:
'http://www.tek-tips.com/viewthread.cfm?qid=794484
'
'----------------------------------------------------
 
Private Declare Function NetScheduleJobAdd Lib "netapi32.dll" _
    (ByVal Servername As String, Buffer As Any, JobID As Long) As Long
 
 
Private Type AT_INFO
    JobTime As Long
    DaysOfMonth As Long
    DaysOfWeek As Byte
    Flags As Byte
    Command As String
End Type
 
 
Private Enum JobAdd
    JOB_RUN_PERIODICALLY = 1&
    JOB_ADD_CURRENT_DATE = 8&
    JOB_NONINTERACTIVE = 16&
End Enum
 
 
Private Enum sjWeekdays
    Monday = 1
    Tuesday = 2
    Wednesday = 4
    Thursday = 8
    Friday = 16
    Saturday = 32
    Sunday = 64
End Enum
 
 
Private Enum sjDays
    d1 = 1
    d2 = 2
    d3 = 4
    d4 = 8
    d5 = 16
    d6 = 32
    d7 = 64
    d8 = 128
    d9 = 256
    d10 = 512
    d11 = 1024
    d12 = 2048
    d13 = 4096
    d14 = 8192
    d15 = 16384
    d16 = 32768
    d17 = 65536
    d18 = 131072
    d19 = 262144
    d20 = 524288
    d21 = 1048576
    d22 = 2097152
    d23 = 4194304
    d24 = 8388608
    d25 = 16777216
    d26 = 33554432
    d27 = 67108864
    d28 = 134217728
    d29 = 268435456
    d30 = 536870912
    d31 = 1073741824
End Enum
 
 
 
Sub Test()
    '(ouverture du bloc notes)
    'Tache ponctuelle dans une minute (ouverture du bloc notes)
    vbScheduleJob "notepad.exe", DateAdd("n", 1, Now), JOB_ADD_CURRENT_DATE

    'vbScheduleJob "notepad.exe", DateAdd("n", 1, Now), JOB_RUN_PERIODICALLY, Wednesday, d4
End Sub
 
 
Private Function vbScheduleJob(strCommand As String, sjTime As Date, _
    AddFlags As JobAdd, Optional DayOfWeek As sjWeekdays = 0, _
    Optional DayOfMonth As sjDays = 0, Optional PCName As String = vbNullString) As Long
    
    Dim myInfo As AT_INFO
    Dim JobID As Long
    
    With myInfo
        .Command = StrConv(strCommand, vbUnicode)
        .Flags = AddFlags
        .JobTime = DateDiff("s", "00:00:00", Format(sjTime, "hh:mm:ss")) * 1000
        .DaysOfWeek = DayOfWeek
        .DaysOfMonth = DayOfMonth
    End With
    
    NetScheduleJobAdd PCName, myInfo, JobID
    
    vbScheduleJob = JobID
End Function

Comment forcer l'affichage d'une image dans 'l'aperçu des images et des télécopies Windows', par macro ?
auteur : SilkyRoad
Vba

Option Explicit

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Sub afficherImage_ApercuWindows()
    'Testé avec Excel2002 et WinXP
    'force l'affichage de l'image avec "L'aperçu des images et des télécopies windows".
    Dim Img As String
    
    Img = "C:\Documents and Settings\nom_utilisateur\dossier\nomfichier.bmp"
    ShellExecute 0, "open", "rundll32.exe", _
        "C:\WINDOWS\System32\shimgvw.dll,ImageView_Fullscreen " & Img, 0, 1
End Sub

Comment lister le statut des ports ?
auteur : SilkyRoad
Vba

Sub listerStatutsPorts()
    Dim Cmd As String
    Dim retVal As Long
        
    Cmd = Environ("COMSPEC") & " /C "
    retVal = Shell(Cmd & "NETSTAT -na> C:\listePorts.txt")
    DoEvents
    ThisWorkbook.FollowHyperlink "C:\listePorts.txt"
End Sub

Comment récupérer des informations sur un exécutable ?
auteurs : Microsoft, SilkyRoad
Utilisez la procédure "AfficherInformationsApplication" pour afficher la boîte de dialogue "Ouvrir".
Sélectionnez un fichier quelconque (ou directement un exécutable) puis cliquez sur le bouton "Ouvrir".

Le code va ensuite récupérer le nom de l'exécutable qui ouvre le fichier sélectionné et afficher des informations sur le programme, notamment:
     *Le nom de l'éditeur
     *la description du programme
     *La version du fichier
     *Le nom interne
     *Le copyright
     *Le nom de l'application
     *Le nom du produit
     *La version du produit

Testé sous WinXP/Excel2007, WinXP/Excel2002 et Win98/Excel97.

Vba

'*********************
'Sources: http://support.microsoft.com/kb/466935/fr
'
'adapté pour une utilisation en VBA Excel
'*********************

Option Explicit

'lptstrFilename: adresse du nom de fichier
'dwHandle: handle d'information sur la version
'dwLen: taille du strBuffer contenant l'information
'lpData: adresse du premier octet du strBuffer contenant l'information
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias _
    "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, _
    ByVal dwLen As Long, lpData As Any) As Long

'La fonction GetFileVersionInfoSize détermine si les informations sur la
'version existent. Si c'est le cas, cette fonction retourne la taille du
'strBuffer contenant l'information et le handle d'information que l'on
'passera à L'API GetFileVersionInfo. Cette dernière permet de récupérer
'les informations sur la version.
'lptstrFilename: adresse du nom de fichier
'lpdwHandle: adresse du handle d'information sur la version
Private Declare Function _
    GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" _
    (ByVal lptstrFilename As String, lpdwHandle As Long) As Long


'La fonction VerQueryValue retourne la partie d'information sur la version:
    'lpvBlock: adresse du premier octet du strBuffer contenant l'information
    'lpszSubBlock: adresse de la partie de l'information qui nous intéresse
    'lplpstrBuffer: adresse du strBuffer contenant la valeur demandée
    'lpcb: adresse de la taille du strBuffer contenant la valeur demandée
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" _
    (pBlock As Any, ByVal lpSubBlock As String, lplpstrBuffer As Any, puLen As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, _
    ByVal Source As Long, ByVal Length As Long)

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
    (ByVal lpString1 As String, ByVal lpString2 As Long) As Long

Public Declare Function FindExecutableA Lib "shell32.dll" (ByVal lpFile As String, _
    ByVal lpdirectory As String, ByVal lpResult As String) As Long

Public Const MAX_FILENAME_LEN = 256



Function DescriptionAppli(ByVal Cible As String, ByVal Donnee As String) As String
    
    Dim s As String, strW As String, strBuffer As String, Lc As String
    Dim Rc As Long, x As Long, p As Long, j As Long, i As Long
    Dim byteTabBuffer(255) As Byte
    Dim TabBuffer() As Byte
    
    s = Donnee
    
    j = GetFileVersionInfoSize(Cible, i)
    If j < 1 Then Exit Function
    
    ReDim TabBuffer(j)
    Rc = GetFileVersionInfo(Cible, 0&, j, TabBuffer(0))
    If Rc = 0 Then
        DescriptionAppli = False
        Exit Function
    End If
    
    Rc = VerQueryValue(TabBuffer(0), "\VarFileInfo\Translation", p, j)
    If Rc = 0 Then Exit Function
    
    MoveMemory byteTabBuffer(0), p, j
    
    x = byteTabBuffer(2) + byteTabBuffer(3) * &H100 + byteTabBuffer(0) * _
        &H10000 + byteTabBuffer(1) * &H1000000
        
    Lc = Hex(x)
        
    Do While Len(Lc) < 8
        Lc = "0" & Lc
    Loop
    
    strBuffer = String(255, 0)
    strW = "\StringFileInfo\" & Lc & "\" & s
    Rc = VerQueryValue(TabBuffer(0), strW, p, j)
    
    If Rc = 0 Then Exit Function
    
    lstrcpy strBuffer, p
    strBuffer = Mid$(strBuffer, 1, InStr(strBuffer, Chr(0)) - 1)
    
    DescriptionAppli = strBuffer
End Function


Function FindExecutable(s As String) As String
    Dim i As Integer
    Dim S2 As String
    
    S2 = String(MAX_FILENAME_LEN, 32) & Chr$(0)
    i = FindExecutableA(s & Chr$(0), vbNullString, S2)
    
    If i > 32 Then
        FindExecutable = Left$(S2, InStr(S2, Chr$(0)) - 1)
        Else
        FindExecutable = ""
    End If
End Function



Sub AfficherInformationsApplication()
    Dim Resultat As String, MonAppli As String, LeFichier As String
    Dim x As Variant, Tableau As Variant
    Dim i As Integer
    
    Tableau = Array("Comments", "CompanyName", "FileDescription", "FileVersion", _
        "InternalName", "LegalCopyright", "LegalTrademarks", "PrivateBuild", _
        "OriginalFileName", "ProductName", "productVersion", "SpecialBuild")
    
    x = Application.GetOpenFilename
    If x = False Then Exit Sub
    
    LeFichier = x
    MonAppli = FindExecutable(LeFichier)
    
    For i = LBound(Tableau) To UBound(Tableau)
        Resultat = Resultat & Tableau(i) & " :  " & _
        DescriptionAppli(MonAppli, Tableau(i)) & vbLf
    Next i
    
    MsgBox Resultat, , "Informations : " & MonAppli
End Sub



Vous pouvez aussi récupérer la version d'une application en utilisant la bibliothèque Microsoft Scripting Runtime:

Vba

Sub versionApplication()
    Dim Fso As Object
    
    Set Fso = CreateObject("Scripting.fileSystemObject")
    MsgBox Fso.getFileVersion("C:\WINDOWS\system32\calc.exe")
End Sub

Comment identifier le système d'exploitation utilisé ?
auteur : SilkyRoad
Vba

Sub SystemeExploitation()
    Dim WmObj As Object, Cible As Object
    Dim Obj As Object
     
    Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")
    Set Cible = WmObj.ExecQuery("Select * from Win32_OperatingSystem")
     
    For Each Obj In Cible
        MsgBox Left(Obj.Name, InStr(1, Obj.Name, "|") - 1) & _
            vbCrLf & Obj.Version
    Next
End Sub

A quoi sert la fonction Environ ?
auteur : SilkyRoad
La fonction Environ Renvoie des informations sur le système d'exploitation.

ALLUSERSPROFILE (Répertoire commun à tous les utilisateurs)
APPDATA (Répertoire Application Data)
CLIENTNAME
CommonProgramFiles (Répertoire des Fichiers communs)
COMPUTERNAME (Nom du PC)
ComSpec
FP_NO_HOST_CHECK
HOMEDRIVE
HOMEPATH
LOGONSERVER
NUMBER_OF_PROCESSORS
OS
Path
PATHEXT
PROCESSOR_ARCHITECTURE
PROCESSOR_IDENTIFIER
PROCESSOR_LEVEL
PROCESSOR_REVISION
ProgramFiles (Répertoire Program Files)
SESSIONNAME
SystemDrive
SystemRoot
TEMP(Répertoire Temp)
TMP
USERDOMAIN
USERNAME (Nom utilisateur connecté à la session)
USERPROFILE
WecVersionForRosebud.5C4
windir (Répertoire WINDOWS)

Vous pouvez boucler sur les variables d'environnement pour récupérer les données:

Vba

Dim i As Integer

For i = 1 To 30
    Cells(i, 1) = Environ(i)
Next i


Ou lire une variable spécifique:

Vba

'Nom de l'utilisateur qui a ouvert la session Windows.
MsgBox Environ("USERNAME")

precedent    sommaire    suivant   

Consultez les autres F.A.Q's


Les sources présentés sur cette pages sont libre de droits, et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une oeuvre intellectuelle protégée par les droits d'auteurs. Copyright ©2008  Developpez LLC. Tout droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à 3 ans de prison et jusqu'à 300 000 E de dommages et intérets. Cette page est déposée à la SACD.

Vos questions techniques : forum d'entraide Accueil - Publiez vos articles, tutoriels, cours et rejoignez-nous dans l'équipe de rédaction du club d'entraide des développeurs francophones. Nous contacter - Copyright 2000..2005 www.developpez.com