3. Script Language > ! User-Macros

User-Macros

Previous Top Next

MiniRobotLanguage (MRL)

VBS-Library

This Library is a Sample how VBS-Code can be used Inline with the Smart Package Robot.

You'll find this file also in the User-Library Folder.

To use this Library in your Script you can copy the file into your Project folder and add the following Line at the end of your Script-Code (example):

#INC:VBS-Library.mrt

Here is the Code of this Library.

It may be different from updated versions of the Library that is in the Library-Folder.

'SPR Script-file: New Script_1

'Purpose:

'Author: TEOT\Theo

'Creation date: 01-06-2017 at 16:43:45

'===========================================================

'#######################################################################

' Test if CDO is available

'#######################################################################

' P1 - Rückgabevariable

: %VB_Is_CDO

' Use TOS

#IF PARAMS=0

GSB.VB_TestCDO|$tos$

#EIF

#IF PARAMS=1

GSB.VB_TestCDO|§§§01

#EIF

END%

:VB_TestCDO

SAV.Save|$$RET

$$TXA=CDO ist auf diesem System nicht installiert.

$$TXB=CDO-Version steht zur Verfügung:=

VBS.VB|TestCDO|$$TXA|$$TXB

Function TestCDO(x)

Dim c

Dim msg

On Error Resume Next

set c = CreateObject("MAPI.Session")

If Err <> 0 then

msg = x(0)

else

msg = x(1)& c.Version

end if

'msgbox msg

TestCDO=msg

End Function

VBE.$$RET

VAI.§§_01=$$RET

SAV.Restore

RET.

'#######################################################################

' Get currentDir to Variable

'#######################################################################

: %VB_CurrDir

' Use TOS

#IF PARAMS=0

GSB.VB_CurrDir|$tos$

#EIF

#IF PARAMS=1

VAO.§§§01=

GSB.VB_CurrDir|§§§01

#EIF

END%

:VB_CurrDir

SAV.Save|$$RET

VBS.VB|Test

Option Explicit

Function Test(x)

Test=CurrentDir()

End Function

Function CurrentDir

' Hole aktuellen Ordner per FileSystemObjekt-Objekt

Dim fso

set fso = CreateObject("Scripting.FileSystemObject")

CurrentDir = fso.GetAbsolutePathName(".")

End Function

VBE.$$RET

VAI.§§_01=$$RET

SAV.Restore

RET.

'#######################################################################

' Aufruf:

' %VB_Input_Box $$RET|Mein Box-Text|Mein Title|Mein Default-Text

' MBX.Result: $$RET|VBS Inputbox Result

: %VB_Input_Box

' Use TOS

#IF PARAMS=0

GSB.VB_Input_Box|$tos$

#EIF

#IF PARAMS=1

VAO.§§§01=

GSB.VB_Input_Box|§§§01

#EIF

#IF PARAMS=2

VAO.§§§01=

GSB.VB_Input_Box|§§§01|§§§02

#EIF

#IF PARAMS=3

VAO.§§§01=

GSB.VB_Input_Box|§§§01|§§§02|§§§03

#EIF

#IF PARAMS=4

VAO.§§§01=

GSB.VB_Input_Box|§§§01|§§§02|§§§03|§§§04

#EIF

END%

' P1 - Rückgabevariable

' P2 - Box-Text

' P3 - Title

' P4 - Default-Text

:VB_Input_Box

SAV.Save|$$RET|$$P02|$$P03|$$P04

' Boxtext

IVV.§§_00|>|1

$$P02=§§_02

ELS.

$$P02=Please enter the Value.

EIF.

' Title

IVV.§§_00|>|2

$$P03=§§_03

ELS.

$$P03=Input-Box

EIF.

' Default Text

IVV.§§_00|>|3

$$P04=§§_04

ELS.

$$P04=-

EIF.

'http://ss64.com/vb/inputbox.html

VBS.VB|Test|$$P02|$$P03|$$P04

Option Explicit

Function Test(x)

Dim tmp

' InputBox(prompt[, title][, default] , xpos][, ypos][, helpfile, context])

tmp = InputBox (x(0),x(1), x(2),200, 300,"", 1)

Test=tmp

End Function

VBE.$$RET

VAI.§§_01=$$RET

SAV.Restore

RET.

'#######################################################################

' Aufruf:

'VAR.$$NAM=Editor

'%VB_AppASctivate $$NAM

: %VB_AppASctivate

' Use TOS

#IF PARAMS=0

GSB.VB_AppActivate|$tos$

#EIF

#IF PARAMS=1

GSB.VB_AppActivate|§§§01

#EIF

END%

' P1 - Application to Activate

:VB_AppActivate

SAV.Save|$$NAM

IVV.§§_00|=|1

$$NAM=§§_01

ELS.

$$NAM=NotePad

EIF.

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

dim tmp,objShell

Set objShell = CreateObject("WScript.Shell")

objShell.AppActivate x(0)

msgbox x(0)

End Function

VBE.

SAV.Restore

RET.

'#######################################################################

' Aufruf:

'VAR.$$NAM=%comspec% /c ipconfig /release

'%VB_RunCMD $$NAM

: %VB_RunCMD

' Use TOS

#IF PARAMS=0

GSB.VB_RunCMD|$tos$

#EIF

#IF PARAMS=1

GSB.VB_RunCMD|§§§01

#EIF

END%

' P1 - Application to Activate

:VB_RunCMD

SAV.Save|$$NAM

IVV.§§_00|=|1

$$NAM=§§_01

ELS.

$$NAM=NotePad

EIF.

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

dim objShell

Set objShell = CreateObject("WScript.Shell")

objShell.run(x(0))

End Function

VBE.

SAV.Restore

RET.

'#######################################################################

' Aufruf:

'VAR.$$NAM=?path\MyBatchfile.cmd

'%VB_RunBatch $$NAM

: %VB_RunBatch

' Use TOS

#IF PARAMS=0

GSB.VB_RunBatch|$tos$

#EIF

#IF PARAMS=1

GSB.VB_RunBatch|§§§01

#EIF

END%

' P1 - Name und Pfad der Batch-Datei

:VB_RunBatch

SAV.Save|$$NAM

IVV.§§_00|=|1

$$NAM=§§_01

ELS.

$$NAM=?path\MyBatchfile.cmd

EIF.

' Auflösung für Spezialordner durchführen

' da VBS. nur vorsichtig, binärkompatibel auflöst.

VAF.$$NAM=$$NAM

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

dim objShell

Set objShell = CreateObject("WScript.Shell")

objShell.run("%comspec% /c "+x(0))

End Function

VBE.

SAV.Restore

RET.

'#######################################################################

' Aufruf:

' Für dieses Beispiel muß eine CMD-Console geöffnet sein.

'STW.ct|ConsoleWindowClass|Eingabeaufforderung

'MLI.

'VAR.$$NAM=DIR{ENTER}

'%VB_Sendkeys $$NAM

: %VB_Sendkeys

' Use TOS

#IF PARAMS=0

GSB.VB_Sendkeys|$tos$

#EIF

#IF PARAMS=1

GSB.VB_Sendkeys|§§§01

#EIF

END%

' P1 - Zu sendender Text

:VB_Sendkeys

SAV.Save|$$NAM

IVV.§§_00|=|1

$$NAM=§§_01

ELS.

$$NAM=Hallo Welt!{ENTER}

EIF.

' Auflösung da VBS. nur vorsichtig, binärkompatibel auflöst.

VAR.$$NAM=$$NAM

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

Dim a

Set a = CreateObject("WScript.Shell")

a.SendKeys x(0)

End Function

VBE.

SAV.Restore

RET.

'#######################################################################

' Aufruf:

'VAR.$$NAM=CMD

'%VB_Execute $$NAM

'VAR.$$NAM=www.fa2.de

'%VB_Execute $$NAM

' Runs a program in a new process.

' https://msdn.microsoft.com/en-us/library/d5fk67ky(v=vs.84).aspx

: %VB_Execute

' Use TOS

#IF PARAMS=0

GSB.VB_Execute|$tos$

#EIF

#IF PARAMS=1

GSB.VB_Execute|§§§01

#EIF

END%

' P1 - Zu sendender Text

:VB_Execute

SAV.Save|$$NAM

IVV.§§_00|=|1

$$NAM=§§_01

ELS.

$$NAM=CMD

EIF.

' Auflösung da VBS. nur vorsichtig, binärkompatibel auflöst.

VAR.$$NAM=$$NAM

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

Dim a

Set a = CreateObject("WScript.Shell")

a.Run x(0)

End Function

VBE.

SAV.Restore

RET.

'#######################################################################

' Aufruf:

'VAR.$$NAM=Desktop

'%VB_Get_SpecialFolder $$NAM|$$RET

'MBX.$$RET

' See:

' https://msdn.microsoft.com/en-us/library/0ea7b5xe(v=vs.84).aspx

'The following Parameters can be given to P1

'AllUsersDesktop

'AllUsersStartMenu

'AllUsersPrograms

'AllUsersStartup

'Desktop

'Favorites

'Fonts

'MyDocuments

'NetHood

'PrintHood

'Programs

'Recent

'SendTo

'StartMenu

'Startup

'Templates

: %VB_Get_SpecialFolder

' Use TOS

#IF PARAMS=1

GSB.VB_Get_SpecialFolder|$$NAM|$tos$

#EIF

#IF PARAMS=2

VAO.§§§01=

GSB.VB_Get_SpecialFolder|$$NAM|§§§01

#EIF

END%

' P1 - Name des Spezialordners

' https://msdn.microsoft.com/en-us/library/0ea7b5xe(v=vs.84).aspx

:VB_Get_SpecialFolder

SAV.Save|$$NAM|$$RET

IVV.§§_00|>|0

$$NAM=§§_01

ELS.

$$NAM=Desktop

EIF.

' Auflösung da VBS. nur vorsichtig, binärkompatibel auflöst.

VAR.$$NAM=$$NAM

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

Dim a,out

set a = CreateObject("WScript.Shell")

out = a.SpecialFolders(x(0))

Test=out

End Function

VBE.$$RET

IVV.§§_00|=|2

§§_02=$$RET

ELS.

$tos$=$$RET

EIF.

SAV.Restore

RET.

'#######################################################################

' More Infos

' https://msdn.microsoft.com/en-us/subscriptions/s6wt333f(v=vs.84).aspx

' https://msdn.microsoft.com/en-us/subscriptions/at5ydy31(v=vs.84).aspx

' %VB_All_NetworkDrives $$RET

' MBX.$$RET

' Aufruf:

'%VB_All_NetworkDrives $$RET

'MBX.$$RET

: %VB_All_NetworkDrives

' Use TOS

#IF PARAMS=0

GSB.VB_All_NetworkDrives|$tos$

#EIF

#IF PARAMS=1

VAO.§§§01=

GSB.VB_All_NetworkDrives|§§§01

#EIF

END%

' P1 - Rückgabevariable

' https://msdn.microsoft.com/en-us/library/t9zt39at(v=vs.84).aspx

:VB_All_NetworkDrives

SAV.Save|$$RET

$$NAM=

VBS.VB|Test|-

Option Explicit

Function Test(x)

dim out,i

Dim WshNetwork,oDrives,oPrinters

Set WshNetwork = CreateObject("WScript.Network")

Set oDrives = WshNetwork.EnumNetworkDrives

out= "Network drive mappings:"

For i = 0 to oDrives.Count - 1 Step 2

out=out+"Drive " & oDrives.Item(i) & " = " & oDrives.Item(i+1)+vbcrlf

Test=out

End Function

VBE.$$RET

IVV.§§_00|=|1

VAI.§§_01=$$RET

ELS.

$tos$=$$RET

EIF.

SAV.Restore

RET.

'#######################################################################

' Aufruf:

'%VB_All_NetworkPrinter $$RET

'MBX.$$RET

: %VB_All_NetworkPrinter

' Use TOS

#IF PARAMS=0

GSB.VB_All_NetworkPrinter|$tos$

#EIF

#IF PARAMS=1

VAO.§§§01=

GSB.VB_All_NetworkPrinter|§§§01

#EIF

END%

' P1 - Rückgabevariable

' https://msdn.microsoft.com/en-us/subscriptions/zhds6k80(v=vs.84).aspx

' More Infos

' https://msdn.microsoft.com/en-us/subscriptions/s6wt333f(v=vs.84).aspx

' https://msdn.microsoft.com/en-us/subscriptions/at5ydy31(v=vs.84).aspx

:VB_All_NetworkPrinter

SAV.Save|$$NAM|$$RET|$$INT

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

dim out,i

Dim WshNetwork,oDrives,oPrinters

Set WshNetwork = CreateObject("WScript.Network")

Set oDrives = WshNetwork.EnumPrinterConnections

out= "Network Printers:"

For i = 0 to oDrives.Count - 1 Step 2

out=out+"Drive " & oDrives.Item(i) & " = " & oDrives.Item(i+1)+vbcrlf

Test=out

End Function

VBE.$$RET

IVV.§§_00|=|1

VAI.§§_01=$$RET

ELS.

$tos$=$$RET

EIF.

SAV.Restore

RET.

'#######################################################################

' Aufruf

'%VB_Get_BIOS $$REC

'MBX.$$REC

' P1 - Rückgabevariable

' P2 - Computername

: %VB_Get_BIOS 1

' Use TOS

#IF PARAMS=1

VAO.§§§01=

SAV.Save|$$PCN

GCN.$$PCN

GSB.VB_Get_BIOS|§§§01|$$PCN

SAV.Restore

#EIF

#IF PARAMS=2

' Rückgabevariable entfernen

VAO.§§§01=

GSB.VB_Get_BIOS|§§§01|§§§02

#EIF

END%

' P1 - Rückgabevariable

' P2 - Computername: VB_Get_BIOS

:VB_Get_BIOS

SAV.Save|$$RET|$$NAM

$$NAM=§§_02

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

dim out,i

Const Title = "BIOS-Daten von "

Dim oWMI, oItem, txt, Machine, tmp

Machine = x(0)

' erzeuge Referenz auf BIOS-Instanz

Set oWMI = GetObject( _

"winmgmts:{impersonationLevel=impersonate}//" & Machine _

).InstancesOf("Win32_BIOS")

txt = machine+vbcrlf

' Auflistung bearbeiten (wir haben nur ein Objekt!)

For Each oItem In oWMI

txt = txt & "Name: " & oItem.Name & vbCRLF

txt = txt & "Beschreibung: " & oItem.Description & vbCRLF

txt = txt & "Hersteller: " & oItem.Manufacturer & vbCRLF

txt = txt & "Version: " & oItem.Version & vbCRLF

txt = txt & "Build: " & oItem.SMBIOSMajorVersion & "." & _

oItem.SMBIOSMinorVersion

' Zeige Ergebnisse

out=txt

Test=out

End Function

VBE.$$RET

IVV.§§_00|=|2

VAI.§§_01=$$RET

ELS.

$tos$=$$RET

EIF.

SAV.Restore

RET.

'#######################################################################

' Aufruf

'%VB_Get_Machine_Info $$REC

'MBX.$$REC

' P1 - Rückgabevariable

' P2 - Computername

: %VB_Get_Machine_Info 1

' Use TOS

#IF PARAMS=1

VAO.§§§01=

SAV.Save|$$PCN

GCN.$$PCN

GSB.VB_Get_Machine_Info|§§§01|$$PCN

SAV.Restore

#EIF

#IF PARAMS=2

' Rückgabevariable entfernen

VAO.§§§01=

GSB.VB_Get_Machine_Info|§§§01|§§§02

#EIF

END%

' P1 - Rückgabevariable

' P2 - Computername: VB_Get_BIOS

:VB_Get_Machine_Info

SAV.Save|$$RET|$$NAM

$$NAM=§§_02

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

dim out

Const Title = "Maschinen-Info"

Dim oSys

Dim txt, tmp, machine

Dim i

machine = x(0)

On Error Resume Next ' Fehlerbehandlung aus

Set oSys = GetObject("winmgmts:" & _

"{impersonationLevel=impersonate}" & _

"!//" & machine & "/root/cimv2:Win32_ComputerSystem=""" & _

machine & """")

If err <> 0 then ' Fehler aufgetreten?

WScript.Echo "Fehler: " & err.number & vbCRLF & _

err.description

WScript.Quit ' kein Objekt vorhanden, exit

End if

On Error Goto 0

' Lese Daten der Maschine

txt = "Systeminformationen von Maschine: " & machine & vbCRLF

txt = txt & "Name: " & oSYS.Name & vbCRLF

txt = txt & "Domain: " & oSYS.Domain & vbCRLF

txt = txt & "Aktueller Benutzer: " & oSYS.UserName & vbCRLF

txt = txt & "Primärer Benutzername: " & oSYS.PrimaryOwnerName & vbCRLF & vbCRLF

txt = txt & "Beschreibung: " & oSYS.Description & vbCRLF

txt = txt & "Hersteller: " & oSYS.Manufacturer & vbCRLF

txt = txt & "Modell: " & oSYS.Model & vbCRLF

txt = txt & "Systemtyp: " & oSYS.SystemType & vbCRLF

txt = txt & "Prozessoren: " & oSYS.NumberOfProcessors & vbCRLF

txt = txt & "Bootup-Delay: " & oSYS.SystemStartUpDelay & vbCRLF

txt = txt & "Bootup-Status: " & oSYS.BootUpState & vbCRLF

txt = txt & "Zeitzone: " & oSYS.CurrentTimeZone & vbCRLF

txt = txt & "Sommerzeit aktiv: " & oSYS.DayLightInEffect & vbCRLF

txt = txt & "Infrarotunterstützung: " & oSYS.InfraredSupported & vbCRLF

txt = txt & "Rolle: " & vbCRLF

For i = LBound(oSYS.Roles) to UBound(oSYS.Roles)

txt = txt & " " & oSYS.Roles(i) & vbCRLF

' Zeige Ergebnisse

out=txt

Test=out

End Function

VBE.$$RET

IVV.§§_00|=|2

VAI.§§_01=$$RET

ELS.

$tos$=$$RET

EIF.

SAV.Restore

RET.

'#######################################################################

' Aufruf

'%VB_Get_Stopped_Services $$REC

'MBX.$$REC

' P1 - Rückgabevariable

: %VB_Get_Stopped_Services

' Use TOS

#IF PARAMS=0

GSB.VB_Get_Machine_Info

#EIF

#IF PARAMS=1

' Rückgabevariable entfernen

VAO.§§§01=

GSB.VB_Get_Stopped_Services|§§§01

#EIF

END%

' P1 - Rückgabevariable

' P2 - Computername: VB_Get_BIOS

:VB_Get_Stopped_Services

SAV.Save|$$RET|$$NAM

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

DIM oService, oWMI

Dim strQuery, txt

strQuery = "Select * From Win32_Service " & _

"Where State='Stopped' "

' Query ausführen

Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}" _

).ExecQuery (strQuery)

If oWMI.Count = 0 Then

WScript.Echo "Keine beendeten Dienste gefunden"

WScript.Quit

End if

txt = "Beendete Dienste " & vbCRLF

' Ergebnisse anzeigen

For Each oService in oWMI

txt = txt & oService.Name & vbCRLF & oService.Description & " (Startmodus: " _

& oService.StartMode & ")" & vbCRLF

' Zeige Ergebnisse

Test=txt

End Function

VBE.$$RET

IVV.§§_00|=|1

VAI.§§_01=$$RET

ELS.

$tos$=$$RET

EIF.

SAV.Restore

RET.

'#######################################################################

' Aufruf

'%VB_Get_CPU_Info $$REC

'MBX.$$REC

' P1 - Rückgabevariable

' P2 - Computername

: %VB_Get_CPU_Info

' Use TOS

#IF PARAMS=1

VAO.§§§01=

SAV.Save|$$PCN

GCN.$$PCN

GSB.VB_Get_CPU_Info|§§§01|$$PCN

SAV.Restore

#EIF

#IF PARAMS=2

' Rückgabevariable entfernen

VAO.§§§01=

GSB.VB_Get_CPU_Info|§§§01|§§§02

#EIF

END%

' P1 - Rückgabevariable

' P2 - Computername: VB_Get_BIOS

:VB_Get_CPU_Info

SAV.Save|$$RET|$$NAM

$$NAM=§§_02

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

Const Title = "CPU-Info"

Dim oCPU, oItem

Dim txt, tmp, machine

Dim i

machine = x(0)

On Error Resume Next ' Fehlerbehandlung aus

' Abfrage der Prozessorinstanz

Set oCPU = GetObject("winmgmts:" & _

"{impersonationLevel=impersonate}" & _

"!//" & machine).InstancesOf("Win32_Processor")

If err <> 0 then ' Fehler aufgetreten?

WScript.Echo "Fehler: " & err.number & vbCRLF & _

err.description

WScript.Quit ' kein Objekt vorhanden, exit

End if

On Error Goto 0

' Jetzt die Informationen aus Auflistung aufbereiten

txt = "Systeminformationen von Maschine: " & machine & vbCRLF

For Each oItem In oCPU ' alle Instanzen

txt = txt & "Family: " & oItem.Family & vbCRLF

txt = txt & "ClockSpeed (MHz): " & oItem.CurrentClockSpeed & vbCRLF

txt = txt & "MaxClockSpeed (MHz): " & oItem.MaxClockSpeed & vbCRLF

txt = txt & "AdressWidth (Bit): " & oItem.AddressWidth & vbCRLF

txt = txt & "DataWidth (Bit): " & oItem.DataWidth & vbCRLF

txt = txt & "LoadPercentage: " & oItem.LoadPercentage & vbCRLF

Test=txt

End Function

VBE.$$RET

IVV.§§_00|=|2

VAI.§§_01=$$RET

ELS.

$tos$=$$RET

EIF.

SAV.Restore

RET.

'#######################################################################

' Das Script zeigt den Zugriff auf eine Access-Datenbank "Test1.mdb"

' die in ?path\liegen muß.

' Es ist nur als Startpunkt gedacht,

' das Skript zeigt nur wie man Datenbank und Tabelle öffnet.

' Aufruf

'%VB_Access_Sample

'MBX.$$REC

: %VB_Access_Sample

GSB.VB_Access_Sample

END%

' P1 - Rückgabevariable

' P2 - Computername: VB_Get_BIOS

:VB_Access_Sample

SAV.Save|$$RET|$$NAM

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

Const dbOpenTable = 1 ' Access-Konstante

DIM objAc ' Objektvariable

Dim ws, db, tb, rs

DIM Title, Text,dbase

Title = "WSH-Beispiel - Access Datenbank"

' Hier erzeugen wir eine Objektreferenz auf Access

Set objAc = CreateObject ("Access.Application")

dbase=CurrentDir() + "\Test1.mdb"

msgbox dbase

' Jetzt auf die Datenbank Test1.mdb zugreifen

objAc.OpenCurrentDatabase dbase

' Einen WorkSpace anlegen

Set ws = objAc.DBEngine.Workspaces(0)

' Hole Tabelle "Names"

Set db = ws.Databases(0) ' aktuelle Datenbank

Set rs = db.OpenRecordset("Names", dbOpenTable)

' Jetzt einen Datensatz einfügen

rs.MoveLast ' letzter Datensatz

rs.AddNew ' Leersatz anhängen

' Jetzt Name und Personalnummer abfragen und zur

' Tabelle hinzufügen.

rs("Name") = InputBox ("Name", Title, "Born") ' Name

rs("PersID") = InputBox ("Pers ID", Title, "123") ' Personalnummer

rs.Update ' jetzt speichern

' Zeige jetzt alle Datensätze an

rs.MoveFirst ' erster Datensatz

Do ' bis zum letzten Datensatz

Text="Record "+ rs("ID").value

Text=Text+rs("Name").value+ " -> Pers ID: "

Text=Text+rs("PersID").value

msgbox Text

rs.MoveNext ' nächster Datensatz

Loop Until (rs.EOF)

' Letzter Datensatz ggf. löschen

If (MsgBox("Letzter Datensatz löschen?", vbQuestion + vbYesNo, Title) = vbYes) Then

rs.MoveLast ' auf letzten Satz

rs.Delete ' löschen

'WScript.Echo "Datensatz gelöscht"

End if

objAc.CloseCurrentDataBase ' Datenbank schließen

objAc.Quit ' Access jetzt schließen

Set objAc = Nothing ' Objektvariable freigeben

end function

Function CurrentDir

' Hole aktuellen Ordner per FileSystemObjekt-Objekt

Dim fso

set fso = CreateObject("Scripting.FileSystemObject")

CurrentDir = fso.GetAbsolutePathName(".")

End Function

VBE.

SAV.Restore

RET.

'#######################################################################

' Das folgende Skript zeigt den Zugriff auf MS-Word.

' Es ist hierfür nur als Startpunkt gedacht.

' Aufruf

'%VB_Word_Sample

'MBX.$$REC

: %VB_Word_Sample

GSB.VB_Word_Sample

END%

' P1 - Rückgabevariable

' P2 - Computername: VB_Get_BIOS

:VB_Word_Sample

SAV.Save|$$RET|$$NAM

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

Const vbNormal = 0 ' Word-Fensterstile

Const vbMaximized = 1

Const vbMinimized = 2

DIM objWrd, objDoc, txt, doc ' Word-Objektvariable

DIM sys

DIM Title, Text

Title = "WSH-Beispiel - by G. Born"

' Hier erzeugen wir eine Objektreferenz auf Word

Set objWrd = CreateObject ("Word.Application")

' Jetzt für die Anzeige des Fensters sorgen

objWrd.WindowState = vbNormal ' Normal

objWrd.Height = 400 ' Höhe

objWrd.Width = 500 ' Breite

objWrd.Left = 20 ' X-Position

objWrd.Top = 20 ' Y-Position

objWrd.Visible = true ' Fenster anzeigen

' Jetzt etwas in die Titeleiste schreiben

objWrd.Caption = Title

' Jetzt ein Dokument-Objekt erzeugen

Set objDoc = objWrd.Documents

objDoc.Add ("Normal.dot")

' Jetzt holen wird das aktuelle Dokument

Set doc = objWrd.ActiveDocument

' Definiere einen Range auf den Textanfang

Set txt = doc.Range(0,0)

' Jetzt sind wir fertig, um Text einzufügen

txt.InsertAfter ("Word-Eigenschaften" & vbCRLF)

txt.InsertAfter ("Fensterhöhe " & vbTab & objWrd.Height & vbCRLF)

txt.InsertAfter ("Fensterbreite " & vbTab & objWrd.Width & vbCRLF)

txt.InsertAfter (vbCRLF)

txt.InsertAfter ("Anwendung" & vbTab & objWrd.Application & vbCRLF)

txt.InsertAfter ("Version" & vbTab & objWrd.Version & vbCRLF)

txt.InsertAfter ("Pfad" & vbTab & objWrd.Name & vbCRLF)

txt.InsertAfter ("Dokument" & vbTab & objWrd.ActiveDocument & vbCRLF)

txt.InsertAfter ("Vorlage" & vbTab & doc.AttachedTemplate & vbCRLF)

Set sys = objWrd.System

txt.InsertAfter (vbCRLF)

txt.InsertAfter ("Prozessor" & vbTab & sys.Processortype & vbCRLF)

txt.InsertAfter ("Coprozessor" & vbTab & sys.MathCoProcessorInstalled & vbCRLF)

txt.InsertAfter ("Drucker" & vbTab & objWrd.ActivePrinter & vbCRLF)

' Setze Range-Objekt auf 1. Absatz und formatiere die Titelzeile fett

Set txt = doc.Paragraphs(1).Range

txt.Bold = true ' fett

objWrd.Statusbar = "Fertig"

If (MsgBox("Soll das Dokument gedruckt werden?", _

vbQuestion + vbYesNo, _

Title) = vbYes) Then

objWrd.PrintOut

Echo "Fertig mit dem Drucken?"

End if

objWrd.Quit ' Word jetzt schließen

Set objWrd = Nothing ' Objektvariable freigeben

end function

VBE.

SAV.Restore

RET.

'#######################################################################

' Das folgende Skript zeigt den Zugriff auf MS-Word via WSH.

' Es ist hierfür nur als Startpunkt gedacht.

' Aufruf

'%VB_Excel_Sample

'MBX.$$REC

: %VB_Excel_Sample

GSB.VB_Excel_Sample

END%

:VB_Excel_Sample

SAV.Save|$$RET|$$NAM

VBS.VB|Test|$$NAM

Option Explicit

Function Test(x)

Const vbNormal = 1 ' Fensterstile

Const vbMinimized = 2

Const vbMaximized = 3

DIM objXL, objWb ' Excel-Objektvariable

DIM Title, Text

Title = "Excel-WSH-Beispiel"

' Hier erzeugen wir eine Objektreferenz auf Excel

Set objXL = CreateObject ("Excel.Application")

' Jetzt für die Anzeige des Fensters sorgen

objXL.WindowState = vbNormal ' Normal

objXL.Height = 200 ' Höhe

objXL.Width = 400 ' Breite

objXL.Left = 100 ' X-Position

objXL.Top = 100 ' Y-Position

objXL.Visible = true ' Fenster anzeigen

' Jetzt etwas in die Titel- und Statusleiste schreiben

objXL.Caption = Title

objXL.Statusbar = "Datum: " & Date

' Frage, ob das Fenster maximiert werden soll

If (MsgBox("Fenster maximieren", _

vbQuestion + vbYesNo, _

Title) = vbYes) Then _

objXL.WindowState = vbMaximized

' Frage jetzt die Excel-Eigenschaften ab

Text = "Excel-Eigenschaften" + vbCRLF + vbCRLF

Text = Text & "Fensterhöhe " & vbTab & objXL.Height & vbCRLF

Text = Text & "Fensterbreite " & vbTab & objXL.Width & vbCRLF

Text = Text & "Fenstertitel " & vbTab & objXL.Caption & vbCRLF

Text = Text & vbCRLF & "Excel wird jetzt beendet"

'WScript.Echo Text

objXL.Quit ' Excel jetzt schließen

Set objXL = Nothing ' Objektvariable freigeben

end function

Function CurrentDir

' Hole aktuellen Ordner per FileSystemObjekt-Objekt

Dim fso

set fso = CreateObject("Scripting.FileSystemObject")

CurrentDir = fso.GetAbsolutePathName(".")+"\"

End Function

VBE.

SAV.Restore

RET.

'#######################################################################

'===========================================================

: %VB_Test

' Use TOS

#IF PARAMS=0

GSB.VB_Test|$tos$

#EIF

#IF PARAMS=1

GSB.VB_Test|§§§01

#EIF

END%

:VB_Test|123

SAV.Save|$$RET

$$TXA=Text 1

$$TXB=Text 2

VBS.VB|Test|$$TXA|$$TXB

Function Test(x)

Test=

End Function

VBE.$$RET

VAI.§§_01=$$RET

SAV.Restore

RET.

'===========================================================