VBS script to check if a site is up and running






Dim strWebsite

strWebsite = "www.sccmrookie.blogspot.com"

If PingSite( strWebsite ) Then
    WScript.Echo "Web site " & strWebsite & " is up and running!"
Else
    WScript.Echo "Web site " & strWebsite & " is down!!!"
End If


Function PingSite( myWebsite )
' This function checks if a website is running by sending an HTTP request.
' If the website is up, the function returns True, otherwise it returns False.
' Argument: myWebsite [string] in "www.domain.tld" format, without the
' "http://" prefix.

    Dim intStatus, objHTTP

    Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )

    objHTTP.Open "GET", "http://" & myWebsite & "/", False
    objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"

    On Error Resume Next

    objHTTP.Send
    intStatus = objHTTP.Status

    On Error Goto 0

    If intStatus = 200 Then
        PingSite = True
    Else
        PingSite = False
    End If

    Set objHTTP = Nothing
End Function
READ MORE »

Deploy Internet Explorer 11 with vbs





The following .VBS file can be use to deploy IE 11 with all updates and selected languages (ex english and spanish)  :

Option Explicit
'On Error Resume Next

Const strComputer = "."
Dim oParamDict : Set oParamDict = CreateObject("Scripting.Dictionary")
Dim kErrorSuccess : kErrorSuccess = "Ok"
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objShell : Set objShell = CreateObject("WScript.Shell")
Dim objEnv : Set objEnv = objShell.Environment("Process")
Dim strScriptPath : strScriptPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Dim LogFile
Dim Return, KBname
Dim logName : logName = "Microsoft_Internet_Explorer_11_Prerequisites.log"
Dim objFolder, oReg, strKeyPath
Dim strValueName, strValue, strLanguage, strArchitecture
Dim strPathArch, strPathLang

objEnv("SEE_MASK_NOZONECHECKS") = 1
logFolder : Set LogFile = objFSO.OpenTextFile("C:\ProgramData\IE11\" & logName, 8, True)
LogFile.WriteLine(vbCrLf & "---------------------------------------------------------------------------------------------------------------------" & vbCrLf)

strLanguage = InstallLanguage
strArchitecture = OSarchitecture

    '-- Folders --
    '..\bin
    '..\x64
    '      \es-ES
    '      \en-US
    '..\x86
    '      \es-ES
    '      \en-US

strPathArch = Replace(strScriptPath,"\bin","\" & strArchitecture)
strPathLang = strPathArch & "\" & strLanguage

' installs prerequisites
LogFile.WriteLine(Now & "  -(1)  Starts to install prerequisites for Internet Explorer 11 " & strArchitecture & " for Windows 7 ...")

'install patch for KB2834140-v2-x..
LogFile.WriteLine(Now & "  -(2)  Installing update KB2834140-v2-" & strArchitecture & " ...")
Return = objShell.Run("wusa.exe " & strPathArch & "\Windows6.1-KB2834140-v2-" & strArchitecture & ".msu /quiet /norestart",0,True)
Results("KB2834140-v2-" & strArchitecture)

'install patch for KB2670838 (graphics and imaging issues fix)
LogFile.WriteLine(Now & "  -(3)  Installing update KB2670838-" & strArchitecture & " ...")
Return = objShell.Run("wusa.exe " & strPathArch & "\Windows6.1-KB2670838-" & strArchitecture & ".msu /quiet /norestart",0,True)
Results("KB2670838-" & strArchitecture)   

'install patch for KB2639308
LogFile.WriteLine(Now & "  -(4) Installing update KB2639308-" & strArchitecture & " ...")
Return = objShell.Run("wusa.exe " & strPathArch & "\Windows6.1-KB2639308-" & strArchitecture & ".msu /quiet /norestart",0,True)
Results("KB2639308-" & strArchitecture)   

'install patch for KB2533623 (Insecure library fix)
LogFile.WriteLine(Now & "  -(5) Installing update KB2533623-" & strArchitecture & " ...")  
Return = objShell.Run("wusa.exe " & strPathArch & "\Windows6.1-KB2533623-" & strArchitecture & ".msu /quiet /norestart /log",0,True)  
Results("KB2533623-" & strArchitecture)

'install patch for KB2731771 (local/UTC time conversion)
LogFile.WriteLine(Now & "  -(6) Installing update KB2731771-" & strArchitecture & " ...")  
Return = objShell.Run("wusa.exe " & strPathArch & "\Windows6.1-KB2731771-" & strArchitecture & ".msu /quiet /norestart /log",0,True)  
Results("KB2731771-" & strArchitecture)

'install 64-bit patch for KB2729094-v2- (Segoe font fix)
LogFile.WriteLine(Now & "  -(7) Installing update KB2729094-v2-" & strArchitecture & " ...")  
Return = objShell.Run("wusa.exe " & strPathArch & "\Windows6.1-KB2729094-v2-" & strArchitecture & ".msu /quiet /norestart /log",0,True)  
Results("KB2729094-" & strArchitecture)

'install patch for KB2786081
LogFile.WriteLine(Now & "  -(8) Installing update KB2786081-" & strArchitecture & " ...")  
Return = objShell.Run("wusa.exe " & strPathArch & "\Windows6.1-KB2786081-" & strArchitecture & ".msu /quiet /norestart /log",0,True)  
Results("KB2786081-" & strArchitecture)

'install IE Support for ..) 
If strArchitecture = "x86" Then
    LogFile.WriteLine(Now & "  -(9) Installing update IE_SUPPORT_" & strArchitecture & strLanguage & " ...")
    If objFSO.FolderExists("C:\Windows\SysNative") Then  
        Return = objShell.Run("C:\Windows\SysNative\dism.exe /online /add-package /packagepath:" & _
            strPathLang & "\IE_SUPPORT_" & strArchitecture & "_ " & strPathLang & ".cab /quiet /norestart /log",0,True)  
    Else
        Return = objShell.Run("dism.exe /online /add-package /packagepath:" & strPathLang & "\IE_SUPPORT_" & _
            strArchitecture & "_" & strPathLang & ".cab /quiet /norestart /log",0,True) 
    End If
    Results("IE_SUPPORT_" & strArchitecture & "_" & strLanguage)
Else
    LogFile.WriteLine(Now & "  -(9) Installing update IE_SUPPORT_amd" & strArchitecture & strLanguage & " ...")
    If objFSO.FolderExists("C:\Windows\SysNative") Then  
        Return = objShell.Run("C:\Windows\SysNative\dism.exe /online /add-package /packagepath:" & _
            strPathLang & "\IE_SUPPORT_amd" & strArchitecture & "_" & strPathLang & ".cab /quiet /norestart /log",0,True)  
    Else
        Return = objShell.Run("dism.exe /online /add-package /packagepath:" & strPathLang & "\IE_SUPPORT_amd" & _
            strArchitecture & "_" & strPathLang & ".cab /quiet /norestart /log",0,True) 
    End If
    Results("IE_SUPPORT_amd" & strArchitecture & "_" & strLanguage)
End If

' strLanguage
' strPathLang

'install patch for KB2888049 (Improve network performance for IE11)  
LogFile.WriteLine(Now & "  -(10) Installing update KB2888049-" & strArchitecture & " ...")  
Return = objShell.Run("wusa.exe " & strPathArch & "\Windows6.1-KB2888049-" & strArchitecture & ".msu /quiet /norestart /log",0,True)  
Results("KB2888049-" & strArchitecture)

'install patch for KB2882822
LogFile.WriteLine(Now & "  -(11) Installing update KB2882822-" & strArchitecture & " ...")  
Return = objShell.Run("wusa.exe " & strPathArch & "\Windows6.1-KB2882822-" & strArchitecture & ".msu /quiet /norestart /log",0,True)  
Results("KB2882822-" & strArchitecture)

'Cambio de la variable idioma para que conincida con la nomenclatura de microsoft.
If strLanguage = "en-US" Then
    strLanguage = Left(strLanguage,2)
End If

'install IE Spelling
LogFile.WriteLine(Now & "  -(12) Installing update IE Spelling_ " & strLanguage & " ...")  
Return = objShell.Run("wusa.exe " & strPathLang & "\IE-Spelling-" & strLanguage & ".msu /quiet /norestart /log",0,True)  
Results("IE-Spelling-" & strLanguage)

'install IE Hyphenation
LogFile.WriteLine(Now & "  -(13) Installing update IE Hyphenation" & strLanguage & " ...")  
Return = objShell.Run("wusa.exe " & strPathLang & "\IE-Hyphenation-" & strLanguage & ".msu /quiet /norestart /log",0,True)  
Results("IE-Hyphenation-" & strLanguage)

'install Internet Explorer 11
LogFile.WriteLine(Now & "  -(14) Installing Internet Explorer 11 for " & strArchitecture & "...")  
LogFile.WriteLine(Now & "  -  The IE 11 Install log is located at :  C:\ProgramData\IE11\Microsoft_Internet_Explorer_11_" & strArchitecture & "_Install.log")

If objFSO.FolderExists("C:\Windows\SysNative") Then
    Return = objShell.Run("C:\Windows\SysNative\dism.exe /online /add-package /packagepath:" & strPathLang & _
         "\IE-Win7.CAB /quiet /norestart /logpath:C:\ProgramData\IE11\Microsoft_Internet_Explorer_11_" & _
          strArchitecture & "_Install.log",0,True) & objShell.Run("C:\Windows\SysNative\dism.exe /online /add-package /packagepath:" & strPathLang & _
         "\ielangpack-es-ES.CAB /quiet /norestart /logpath:C:\ProgramData\TIE11\Microsoft_Internet_Explorer_11_" & _
          strArchitecture & "_Install.log",0,True)
        

Else      
    Return = objShell.Run("dism.exe /online /add-package /packagepath:" & strPathLang & _
        "\IE-Win7.CAB /quiet /norestart /logpath:C:\ProgramData\IE11\Microsoft_Internet_Explorer_11_" & _
         strArchitecture & "_Install.log",0,True) & objShell.Run("dism.exe /online /add-package /packagepath:" & strPathLang & _
        "\ielangpack-es-ES.CAB /quiet /norestart /logpath:C:\ProgramData\IE11\Microsoft_Internet_Explorer_11_" & _
         strArchitecture & "_Install.log",0,True) 
End If


If Return = 3010 Then      
    LogFile.WriteLine(Now & "  -  WARNING: Installation of Internet Explorer 11 has completed successfully, however, required reboot was suppressed!")      
    WScript.Quit(0)  
ElseIf Return <> 0 Then      
    LogFile.WriteLine(Now & "  -  ERROR: Installation of Internet Explorer 11 has failed with error: " & RETURN)  
Else      
    LogFile.WriteLine(Now & "  -  Installation of Internet Explorer 11 has completed successfully.")  
End If

If kErrorSuccess <> "Ok" Then
    Usage(True)
End If

LogFile.Close
WScript.Quit(0)

'--------------------------------------------------------------------------------------------------------------------

Function InstallLanguage
    Const HKEY_LOCAL_MACHINE = &H80000002   
    'strComputer = "."   
    Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")   
    strKeyPath = "SYSTEM\CurrentControlSet\Control\Nls\Language"
    strValueName = "InstallLanguage"
    oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath, _
    strValueName,strValue   
    Select Case strValue
        Case "0C0A"
        LogFile.WriteLine(Now & " - OS installation language: Spanish")   
        InstallLanguage = "es-ES"
        Case "0409"
        LogFile.WriteLine(Now & " - OS installation language: English")
        InstallLanguage = "en-US"
        Case Else
        kErrorSuccess = "Error - OS installation language not supported (" & strValue & ") only Spanish or English"           
        Usage(True)
    End Select   
End Function

Function OSarchitecture
    Const HKEY_LOCAL_MACHINE = &H80000002   
    'strComputer = "."   
    Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")   
    strKeyPath = "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"   
    strValueName = "PROCESSOR_ARCHITECTURE"
    oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,OSarchitecture   
    LogFile.WriteLine(Now & " - OS Architecture: " & OSarchitecture )           
End Function

'Functions
'---------------------------------------------------------------------------------------------------------------------
Function Results(KBname)  
    Select Case Return      
        Case 9009              
        LogFile.WriteLine(Now & "  -  WARNING: " & KBname & " is already installed; skipping installation.")              
        Case 2359302                  
        LogFile.WriteLine(Now & "  -  WARNING: " & KBname & " is already installed; skipping installation.")              
        Case -2145124329                  
        LogFile.WriteLine(Now & "  -  WARNING: " & KBname & " is not required for this system; skipping installation.")              
        Case Else                  
        LogFile.WriteLine(Now & "  -  Install of " & KBname & " has completed with return code: " & RETURN)          
    End Select   
End Function

Function logFolder
    'Set objFSO = CreateObject("Scripting.FileSystemObject")   
    If objFSO.FolderExists("C:\ProgramData\IE11") Then
        Set objFolder = objFSO.GetFolder("C:\ProgramData\IE11")
    Else
        Set objFolder = objFSO.CreateFolder("C:\ProgramData\IE11")
    End If
End Function

Sub Usage(bExit)
    LogFile.WriteLine(Now & " - " & kErrorSuccess )
    If bExit Then
        WScript.Quit(1)
    End If
End Sub
READ MORE »

Disable Acrobat Reader update batch file




The following batch file install the reg key that blocks adobe acrobat reader updates. You can add as many Adobe reader version a syou need into the reg file version.




@echo off

regedit.exe /s "%~dp0acrobatReader_noupdate.reg"
pause



****************************************************************


[HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Adobe\Acrobat Reader\10.0\FeatureLockDown]
"bUpdater"=dword:00000000

[HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Adobe\Acrobat Reader\11.0\FeatureLockDown]
"bUpdater"=dword:00000000
READ MORE »

VBS Script to install SCCM 2012 Client



The following script is usefull toinstall SCCM 2012 client. You can also include it in a standard GPO: it checks first if the client is already installed in the machine:


Option Explicit

On Error Resume Next

Dim FICHERO, MAQUINA
Dim strServiceSCCM,strServiceFramework
Dim objNETWORK, objFSO, objShell,objSysEnv
Dim strSMS_InstallPath, strSMS_Parameters
Dim strReinstallService

Set objNETWORK = WScript.CreateObject("WScript.NETWORK" )
Set objFSO = CreateObject("Scripting.FileSystemObject" )
Set objShell = WScript.CreateObject("WScript.Shell" )
Set objSysEnv = objShell.Environment("Process" )

strServiceSCCM = "CcmExec"


strSMS_InstallPath = "\\@Servername@\client$\ccmsetup.exe"
strSMS_Parameters = "SMSSITECODE=PLM"


MAQUINA = objNETWORK.COMPUTERNAME

'    If isServiceRunning(strServiceSCCM) = False Then
'    objShell.Run strSMS_InstallPath & " " & strSMS_Parameters, 1, True
'    strReinstallService = strReinstallService  & " | " & strServiceSCCM
'    End If

If objFSO.FolderExists(objSysEnv("SYSTEMROOT" )&"\CCM" ) Then
    ' Check for an SMS executable
    If ObjFSO.FileExists(objSysEnv("SYSTEMROOT" )&"\CCM\CcmExec.exe" ) Then
        Wscript.quit
    End If
End If

objShell.Run strSMS_InstallPath & " " & strSMS_Parameters, 1, True

SET FICHERO = objFSO.opentextfile ("\\@Servername@\client$\ccmsetup\client$\result.txt",8, TRUE)
    FICHERO.WRITELINE MAQUINA & " -- " & Now & strReinstallService

FICHERO.CLOSE


' Function to check if a service SCCM is running
Function isServiceRunning(strService)
    Dim objWMIService, strWMIQuery

    strWMIQuery = "Select * from Win32_Service Where Name = '" & strService & "' and state='Running'"

    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

    If objWMIService.ExecQuery(strWMIQuery).Count > 0 Then
        isServiceRunning = True
    Else
        isServiceRunning = False
    End If

End Function
READ MORE »

Count Number of times computer has turned on

The following scripts can be used to count the number of times a computer has been turned on:

*****************************************
count = 0
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery _
("Select * from Win32_NTLogEvent Where Logfile = 'System'" _
& " and EventCode = '12'")
For Each objEvent in colLoggedEvents
count = count + 1
Next
wscript.echo "Number of times operating system has started:   " & count

*********************************************


If you want to check a remote machine here's the script:

***************************************************
count = 0
strComputer=InputBox ("Enter the network name for the remote computer")
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery _
("Select * from Win32_NTLogEvent Where Logfile = 'System'" _
& " and EventCode = '12'")
For Each objEvent in colLoggedEvents
count = count + 1
Next
wscript.echo "Number of times operating system has started:   " & count
**********************************************
READ MORE »

VBS Script to delete Folder

You can this simple .vbs script to delete folders:


************************************************


 '====================================================================
'
' NAME: 
'
' AUTHOR:  
' DATE  : 07/11/2012
'
' COMMENT: 
'exemplary damages arising out of or in any way relating to the use of this script, 
'including without limitation damages for loss of goodwill, work stoppage, 
'lost profits, loss of data, and computer failure or malfunction. 
'You bear the entire risk as to the quality and performance of this script.
'
'===================================================================




dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")
If filesys.FolderExists("c:\example\") Then 
   filesys.DeleteFolder "c:\example"
     End If 


************************************************************
READ MORE »

Script to extract users data from Active Directory (VBS)

This script will extract users data (machine name, last logon,OS,OU name) from your AD and it will autocratically save into a .csv file :



********************************************

'====================================================================
'
' NAME: 
'
' AUTHOR:  
' DATE  : 11/01/2012
'
' COMMENT: 
'Exemplary damages arising out of or in any way relating to the use of this script, 
'including without limitation damages for loss of goodwill, work stoppage, 
'lost profits, loss of data, and computer failure or malfunction. 
'You bear the entire risk as to the quality and performance of this script.
'
'
'====================================================================

Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim HostName, DisName, Domain 
Dim Ruta(51) 

    'Sheets("AD_Computers").Select

Set adoCommand = CreateObject("ADODB.Command")
Set ADOConnection = CreateObject("ADODB.Connection")
ADOConnection.Provider = "ADsDSOObject"
ADOConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = ADOConnection

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on computer objects.
strFilter = "(&(objectCategory=computer))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "name,distinguishedName,lastLogonTimestamp,operatingSystem"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute
Domain = "Domain.COM"

    Set FICHERO = objFSO.opentextfile("AD_COMPUTERS.csv", 2, True)
     FICHERO.WRITELINE "Machine Name;lastLogonTimeStamp;Operating System;System OU Name"
    FICHERO.Close

' Enumerate the resulting recordset.

Do Until adoRecordset.EOF
i = i + 1

    On Error Resume Next
    HostName = adoRecordset.Fields("name").Value
    DisName = adoRecordset.Fields("distinguishedName").Value
OS = adoRecordset.Fields("operatingSystem").Value

   Set objDate = adoRecordset.Fields("lastLogonTimeStamp").Value
    
    If (Err.Number <> 0) Then
        On Error GoTo 0
        dtmDate = #1/1/1601#
    Else
        On Error GoTo 0
        lngHigh = objDate.HighPart
        lngLow = objDate.LowPart
        If (lngLow < 0) Then
            lngHigh = lngHigh + 1
        End If
        If (lngHigh = 0) And (lngLow = 0) Then
            dtmDate = #1/1/1601#
        Else
            dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow) / 600000000 - lngBias) / 1440
        End If
    End If

    ' Display values for the user.
    If (dtmDate = #1/1/1601#) Then
        Tiempo = "Never"
    Else
        Tiempo = dtmDate
Tiempo = left(Tiempo,InStr(1,Tiempo, " ") -1)
Tiempo = day (Tiempo) & "/" & month (Tiempo)  & "/" & year (Tiempo)
    End If

    distinguishedName = DisName
     

AD = Split(DisName, ",")
    
    i2 = 50
    For Each Item In AD
      If Left(Item, 3) = "OU=" Then
       Ruta(i2) = Replace(Item, "OU=", "/")
       i2 = i2 - 1
      End If
      
    Next
    
    DisName = ""
    For i3 = 1 To 50
    If Ruta(i3) <> "" Then DisName = DisName + Ruta(i3)
    
    Next

    
    If DisName = "" Then DisName = "/COMPUTERS"
    

    Set FICHERO = objFSO.opentextfile("AD_COMPUTERS.csv", 8, True)
     on error resume next
     FICHERO.WRITELINE ucase(HostName) & ";" & Tiempo & ";" & OS & ";" & ucase(Domain & DisName)
     on error goto 0
    FICHERO.Close
    


    'Range("A" & i).Select
   ' Range("A" & i).Value = HostName
   ' Range("B" & i).Value = Domain & DisName
   ' Range("C" & i).Value = distinguishedName

'If i = 5760 Then
'MsgBox "va"
'End If
    'Move to the next record in the recordset.
     adoRecordset.MoveNext
     Erase Ruta

Loop
' Clean up.
adoRecordset.Close
ADOConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set ADOConnection = Nothing
Set adoCommand = Nothing

msgbox "END"

**************************************

READ MORE »

This script creates a message box to tell the user that on the next reboot the machine will installed a determined software.then it writes a reg key to run the package or other scripts. You can send this script before running the actual package installation:

******************************************************



' NAME: MsgBox
'
' AUTHOR:  
'
' DATE  : 12/02/2014
'
' COMMENT: create a msgbox for user while writes a reg key in runonce.
'
'exemplary damages arising out of or in any way relating to the use of this script, 
'including without limitation damages for loss of goodwill, work stoppage, 
'lost profits, loss of data, and computer failure or malfunction. 
'You bear the entire risk as to the quality and performance of this script.
'
'$~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Option Explicit 
Dim Fichero
Dim lcScriptPath
Dim lcScriptName
Dim App_Path
Dim oShell,ofso,strRuta
Dim Shell
Dim objFso
Dim strPath
Set ofso = CreateObject("Scripting.FileSystemObject") 
Set oShell = WScript.CreateObject("WScript.Shell")


 MsgBox "A package has been delivered to your computer, please reboot for changes to be applied.", vbOKOnly, "@soft name"
  

Set shell= createobject("WSCRIPT.SHELL")
Set objFso = CreateObject("Scripting.FileSystemObject")
strPath = objFso.GetParentFolderName(WScript.ScriptFullName)


strRuta= "cscript.exe " & strPath & "\2_CopyFileSAPlogon.vbs"


oShell.regwrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\Copy@@Program.exe@@",strRuta,"REG_SZ"
  
  
  
  strRuta = ""
Set ofso=Nothing
Set oShell= Nothing
WScript.Quit

****************************************************
READ MORE »

Vbs script to ping from .txt machine list txt

This is a script that will ping all the machines you put in the "Machinelist.txt" and report to an Excel file the result:

'===================================================
'
' NAME: Ping Script
'
' AUTHOR:   
' DATE  : 09/07/2013
'
' COMMENT: create file MachineList.Txt on C:\
' 
'
'exemplary damages arising out of or in any way relating to the use of this script, 
'including without limitation damages for loss of goodwill, work stoppage, 
'lost profits, loss of data, and computer failure or malfunction. 
'You bear the entire risk as to the quality and performance of this script.
'
'=================================================

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2

objExcel.Cells(1, 1).Value = "Server Name"
objExcel.Cells(1, 2).Value = "IP Address"

Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")

Do While Not (InputFile.atEndOfStream)
HostName = InputFile.ReadLine

Set WshShell = WScript.CreateObject("WScript.Shell")
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)

objExcel.Cells(intRow, 1).Value = HostName

Select Case Ping
Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
Case 1 objExcel.Cells(intRow, 2).Value = "Off Line"
End Select

intRow = intRow + 1
Loop

objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True

objExcel.Cells.EntireColumn.AutoFit 
READ MORE »

Active directory extraction vbs script

This Script will allow you to extract from AD some useful data list (machine name, last login,) and export automatically into a .csv file. Just make sure you have enough rights to run it:



'=============================================
'
' NAME: 
'
' AUTHOR:  
' DATE  : 11/01/2012
'
' COMMENT: 
'Exemplary damages arising out of or in any way relating to the use of this script, 
'including without limitation damages for loss of goodwill, work stoppage, 
'lost profits, loss of data, and computer failure or malfunction. 
'You bear the entire risk as to the quality and performance of this script.
'
'
'============================================

Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim HostName, DisName, Domain 
Dim Ruta(51) 

    'Sheets("AD_Computers").Select

Set adoCommand = CreateObject("ADODB.Command")
Set ADOConnection = CreateObject("ADODB.Connection")
ADOConnection.Provider = "ADsDSOObject"
ADOConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = ADOConnection

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on computer objects.
strFilter = "(&(objectCategory=computer))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "name,distinguishedName,lastLogonTimestamp,operatingSystem"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute
Domain = "@Domain Name"

    Set FICHERO = objFSO.opentextfile("AD_Extract.csv", 2, True)
     FICHERO.WRITELINE "Machine Name;lastLogonTimeStamp;Operating System;System OU Name"
    FICHERO.Close

' Enumerate the resulting recordset.

Do Until adoRecordset.EOF
i = i + 1

    On Error Resume Next
    HostName = adoRecordset.Fields("name").Value
    DisName = adoRecordset.Fields("distinguishedName").Value
OS = adoRecordset.Fields("operatingSystem").Value

   Set objDate = adoRecordset.Fields("lastLogonTimeStamp").Value
    
    If (Err.Number <> 0) Then
        On Error GoTo 0
        dtmDate = #1/1/1601#
    Else
        On Error GoTo 0
        lngHigh = objDate.HighPart
        lngLow = objDate.LowPart
        If (lngLow < 0) Then
            lngHigh = lngHigh + 1
        End If
        If (lngHigh = 0) And (lngLow = 0) Then
            dtmDate = #1/1/1601#
        Else
            dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow) / 600000000 - lngBias) / 1440
        End If
    End If

    ' Display values for the user.
    If (dtmDate = #1/1/1601#) Then
        Tiempo = "Never"
    Else
        Tiempo = dtmDate
Tiempo = left(Tiempo,InStr(1,Tiempo, " ") -1)
Tiempo = day (Tiempo) & "/" & month (Tiempo)  & "/" & year (Tiempo)
    End If

    distinguishedName = DisName
     

AD = Split(DisName, ",")
    
    i2 = 50
    For Each Item In AD
      If Left(Item, 3) = "OU=" Then
       Ruta(i2) = Replace(Item, "OU=", "/")
       i2 = i2 - 1
      End If
      
    Next
    
    DisName = ""
    For i3 = 1 To 50
    If Ruta(i3) <> "" Then DisName = DisName + Ruta(i3)
    
    Next

    
    If DisName = "" Then DisName = "/COMPUTERS"
    

    Set FICHERO = objFSO.opentextfile("AD_COMPUTERS.csv", 8, True)
     on error resume next
     FICHERO.WRITELINE ucase(HostName) & ";" & Tiempo & ";" & OS & ";" & ucase(Domain & DisName)
     on error goto 0
    FICHERO.Close
    


    'Range("A" & i).Select
   ' Range("A" & i).Value = HostName
   ' Range("B" & i).Value = Domain & DisName
   ' Range("C" & i).Value = distinguishedName

'If i = 5760 Then
'MsgBox "va"
'End If
    'Move to the next record in the recordset.
     adoRecordset.MoveNext
     Erase Ruta

Loop
' Clean up.
adoRecordset.Close
ADOConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set ADOConnection = Nothing
Set adoCommand = Nothing

msgbox "END"
READ MORE »

SCCM clean cache vbs script

The following script will clean all machine sccm cache, Watch OUT: It works only on machines with SCCM 2007 client.

'$~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'
' NAME: Clean Cache
'
' AUTHOR:
' DATE  : 01/03/2013
'
' COMMENT:
'
'Exemplary damages arising out of or in any way relating to the use of this script,
'including without limitation damages for loss of goodwill, work stoppage,
'lost profits, loss of data, and computer failure or malfunction.
'You bear the entire risk as to the quality and performance of this script.
'$~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



Dim objFSO
Dim objFolder
Dim objSubFolder
Dim winsh
Dim winenv

'deletes folders with a date modified of 7 day or older
Const intDaysOld = 7
set winsh = CreateObject("WScript.Shell")
set winenv = winsh.Environment("Process")
windir = winenv("WINDIR")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'looks for \system32\ccm\cache for 32bit
if objFSO.FolderExists (windir & "\system32\ccm\cache") Then
Set objFolder = objFSO.GetFolder(windir & "\system32\ccm\cache")
For Each objSubFolder In objFolder.SubFolders
                If objSubFolder.DateLastModified < DateValue(Now() - intDaysOld) Then
           objSubFolder.Delete True
    End If
Next
  Wscript.quit
End if
'looks for \sysWOW64\ccm\cache for 64bit
if objFSO.FolderExists (windir & "\sysWOW64\ccm\cache") Then
Set objFolder = objFSO.GetFolder(windir & "\sysWOW64\ccm\cache")
For Each objSubFolder In objFolder.SubFolders
                If objSubFolder.DateLastModified < DateValue(Now() - intDaysOld) Then
           objSubFolder.Delete True
    End If
Next
End if

READ MORE »