Vypnout PC 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 'WMI - Easy Shutdown 'If you have gotten tired of having to click several items just to 'shutdown your PC or laptop, save this script to a .vbs file and 'create an icon for it. It will shutdown your machine with just 'one click. No prompts, no waiting, just power down. 'I've also included a few of the other constants just in case you need a slight variation. Sub ForceReBoot() nLogOff = 0 'Alternative actions to force reboot nReboot = 2 nForceLogOff = 4 nForceReboot = 6 nPowerDown = 8 nForcePowerDown = 12 Set oOS = GetObject("winmgmts:{(Shutdown)}").ExecQuery("Select * from Win32_OperatingSystem") For Each oOperatingSystem in oOS oOperatingSystem.Win32Shutdown(nForceReboot) Next End sub' ForceReBoot Sub SleepDelay () For i = 1 to 5 ' Wait 10 seconds (1000ms = 1 second) Wscript.Sleep 10*(1000) Next 'i End Sub 'SleepDelay
Jak zjistit IP adresu pocitace Deklarace vlastniho typu 1 2 3 4 5 Private Type ty_s_PC_Properties g_numb As String ip_add As String status As String End Type Hlavni makro pro nacteni PC z MS Excel a doplneni vysledku do tabulky 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 36 37 38 39 'this sub calls the above function using a for each loop Sub GetIPStatus() 'declaring variables Dim Cell As Range Dim ipRng As Range Dim Result As String Dim objPC As ty_s_PC_Properties Dim Wks As Worksheet Dim StartTime As Double Dim SecondsElapsed As Double 'this clears the current Ping Status column (not necessary but visually helpful Worksheets("List2").Range("B2:B10000").Clear 'this starts a time to see how long the status check takes StartTime = Timer 'setting values of variables Set Wks = Worksheets("List2") Set ipRng = Wks.Range("A2") Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp) Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd)) 'this is a loop that feeds each server from the list into the GetPingResult function For Each Cell In ipRng objPC = GetPingResult(Cell) Cell.Offset(0, 1) = objPC.ip_add Cell.Offset(0, 2) = objPC.status Next Cell 'this calculates the time it took to run the script and converts it to minutes SecondsElapsed = Round(Round(Timer - StartTime, 2) / 60) 'this displays the final time taken and lets the user know everything has completed MsgBox "This code ran successfully in " & SecondsElapsed & " minutes", vbInformation End Sub Funkce PING pres VBA 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 'This function does the pinging Private Function GetPingResult(Host) As ty_s_PC_Properties 'declaring variables Dim objPing As Object Dim objStatus As Object Dim objResult As ty_s_PC_Properties 'String 'ping the host Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _ ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'") 'report the results For Each objStatus In objPing ' -- With objResult .g_numb = Host .ip_add = objStatus.ProtocolAddress .status = getStatusCode(objStatus.StatusCode) End With ' -- GetPingResult = objResult 'strResult Next 'reset object ping variable Set objPing = Nothing End Function Funkce pro vraceni statusu (konstanty) 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 Private Function getStatusCode(StatusCode) As String Dim strResult As String '--- Select Case StatusCode Case 0: strResult = "Connected" Case 11001: strResult = "Buffer too small" Case 11002: strResult = "Destination net unreachable" Case 11003: strResult = "Destination host unreachable" Case 11004: strResult = "Destination protocol unreachable" Case 11005: strResult = "Destination port unreachable" Case 11006: strResult = "No resources" Case 11007: strResult = "Bad option" Case 11008: strResult = "Hardware error" Case 11009: strResult = "Packet too big" Case 11010: strResult = "Request timed out" Case 11011: strResult = "Bad request" Case 11012: strResult = "Bad route" Case 11013: strResult = "Time-To-Live (TTL) expired transit" Case 11014: strResult = "Time-To-Live (TTL) expired reassembly" Case 11015: strResult = "Parameter problem" Case 11016: strResult = "Source quench" Case 11017: strResult = "Option too big" Case 11018: strResult = "Bad destination" Case 11032: strResult = "Negotiating IPSEC" Case 11050: strResult = "General failure" Case Else: strResult = "Unknown host" End Select '--- getStatusCode = strResult End Function
Seznam konstant jazyka VBScript Seznam konstant jazyka VBScript Zápis konstant (jejich textový zápis) lze použít kdekoliv ve skriptu místo aktuálních hodnot, což umožňuje pohodlný zápis hodnoty bez znalosti její číselné hodnoty. Používání textového zápisu konstant také dělá skript přehlednějším a snadněji upravovatelným. Protože konstanty jsou definovány ve VBScriptu, nemusí být deklarovány ve skriptu. VBScript konstanty hodnot datových typů (Viz také Datové typy VBScript) : Konstanta Popis true Klíčové slovo booleovské hodnoty "Pravda" (odpovídá hodnotě -1 !!) false Klíčové slovo booleovské hodnoty "Nepravda" (odpovídající hodnotě 0) Empty Klíčové slovo indikující, že proměnná nebyla inicializována Null Klíčové slovo indikující, že proměnná obsahuje neplatná data Nothing Klíčové slovo indikující, že proměnná typu Object neukazuje na žádný objekt VBScript konstanty datových typů : Konstanta Hodnota Popis vbEmpty 0 datový typ neinicializován vbNull 1 neobsahuje platná data vbBoolean 11 datový typ Boolean vbByte 17 datový typ Byte vbInteger 2 datový typ Integer vbLong 3 datový typ Long vbSingle 4 datový typ Single vbDouble 5 datový typ Double vbDate 7 datový typ Date vbString 8 datový typ String vbObject 9 datový typ Object vbVariant 12 datový typ Variant vbArray 8192 datový typ Array (pole) VBScript konstanty řetězců (hodnoty těchto konstant lze také vytvořit funkcí Chr) : Konstanta Hodnota Popis vbCr Chr(13) Začátek řádku (Carriage return) vbCrLf Chr(13) & Chr(10) Začátek nového řádku vbFormFeed Chr(12) Nová strana (Form feed); neužívané v OS Windows vbLf Chr(10) Nový řádek (Line feed) vbNewLine Chr(13) & Chr(10) nebo Chr(10) závisí na platformě. Někdy je nutná kombinace vbCrLf (pozice na začátku nového řádku), někdy stačí vbLf (pozice na novém řádku) vbNullChar Chr(0) znak s hodnotou 0 vbNullString String mající hodnotu 0 Volání externích procedur. Není stejná jako řetězec s nulovou délkou (""). vbTab Chr(9) horizontální tabulátor VBScript konstanty datumu a času : Konstanta Hodnota Popis vbSunday 1 Neděle vbMonday 2 Pondělí vbTuesday 3 Úterý vbWednesday 4 Středa vbThursday 5 Čtvrtek vbFriday 6 Pátek vbSaturday 7 Sobota vbFirstJan1 1 týden, ve kterém se vyskytuje 1. leden vbFirstFourDays 2 1. týden, který obsahuje alespoň 4 dny daného roku vbFirstFullWeek 3 první týden, který je celý tvořen dny daného roku vbUseSystem 0 formát datumu definovaný v regionálním nastavení PC vbUseSystemDayOfWeek 0 pro den v týdnu použije den podle nastavení PC
Function Priklady funkci 1 2 3 4 5 6 7 Function Area(Length As Double, Optional Width As Variant) If IsMissing(Width) Then Area = Length * Length Else Area = Length * Width End If End Function