Kategorie: Programmierung

Umgebungsvariable per VBS setzen

22. März 20121. April 2012 Daniel Lensing Keine Kommentare

Es kann manchmal von Vorteil sein Umgebungsvariablen per VBS-Skript zu verteilen, da Sie im Gegensatz zu relativ festen Einbindungen per Standard-Gruppenrichtlinie flexibler gehalten werden können.

Hier ein kleines Beispiel:

Dim WSHShell
Set WSHShell = WScript.CreateObject("WScript.Shell")
WSHShell.Environment("User").item("Bezeichnung") = "Wert"
Set WSHShell = Nothing
WScript.Quit(0)

Dieses Beispiel legt nun eine Variable im Benutzerbereich an. Um eine Variable im Bereich des allgemeinen Computers anzulegen, muss recht einfach der Eintrag „User“ auf „System“ geändert werden.

Die Bezeichnung und der Wert können selbstverständlich auch mit Übergaben von Werten aus anderen Programmbereichen erfolgen.

VBS

Benutzer-Import per VBS anhand Excel-Liste

28. Februar 201216. Oktober 2012 Daniel Lensing Keine Kommentare

Manchmal erhält man eine Liste mit Benutzern, die so schnell wie möglich in ein Active Directory hinzugefügt werden soll. Dieses kann man unter anderem mit dieser VBS-Datei sehr komfortabel durchführen

Dim objExcel, objOpenDialog, objOU, objContact, objRecip
Dim strVorname, strNachname, strEmail, strDesc, Datei
Dim strLogin, strDepartment, strPassword, strUser, strOU
 
Datei = Inputbox ("Dateinamen inkl. Pfad eingeben:")
strOU = Inputbox ("LDAP://-Pfad eingeben:")
 
Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Workbooks.Open Datei
 
'Erste Zeile enthält die Überschriften
i = 2
Do While objExcel.Worksheets(1).Cells(i,3).Value <> ""
strVorname&nbsp; = objExcel.Worksheets(1).Cells(i,1).Value
strNachname = objExcel.Worksheets(1).Cells(i,2).Value
strEmail&nbsp; = objExcel.Worksheets(1).Cells(i,3).Value
strDepartment&nbsp; = objExcel.Worksheets(1).Cells(i,4).Value
strUser = objExcel.Worksheets(1).Cells(i,5).Value
strPassword&nbsp; = objExcel.Worksheets(1).Cells(i,6).Value
strLogin&nbsp; = objExcel.Worksheets(1).Cells(i,7).Value
 
Set objOu = GetObject("LDAP://" & strOU)
 
Set objUser = objOu.Create("User", "cn=" & strUser)
objUser.Put "samaccountname", strUser
objUser.Put "userprincipalname",&nbsp;strUser & "@testing.local"
objUser.Put "sn", strNachname
objUser.Put "displayName", strNachname & ", " & strVorname
objUser.Put "department", strDepartment
objUser.Put "mail", strEMail
objUser.SetInfo
 
 
objUser.SetPassword strPassword
objUser.Put "pwdLastSet", 0
objUser.AccountDisabled = False
objUser.Put "scriptpath", strLogin
objUser.SetInfo
 
i = i + 1
Loop
 
objExcel.ActiveWorkbook.Saved = True
 
objExcel.Application.Quit
 
WScript.Echo "User erfolgreich angelegt!"
WScript.Quit

Beim Start des Programms wird der Dateiname inkl. Pfad der zu importierenden Excel-Datei abgefragt, der zum Beispiel so eingegeben werden muss:

E:\Import\Mappe1.xls

Als nächstes wird nach dem LDAP-Pfad gefragt in dem die Benutzer angelegt werden sollen. Dieser kann wie folgt deklariert werden:

ou=import,dc=testing,dc=local

Den folgenden Definitionen muss die Excel-Datei unterliegen:

Import wird ab der zweiten Zeile durchgeführt, so dass in der Ersten Überschriften definiert sein können.
Spalte 1: Vorname
Spalte 2: Nachname
Spalte 3: E-Mail-Adresse (diese wird nicht automatisch im Exchange angelegt, sondern nur hinterlegt)
Spalte 4: Abteilung
Spalte 5: Benutzername
Spalte 6: Passwort
Spalte 7: Loginskript

Bei dem Passwort muss darauf geachtet werden, dass für den Import ein Passwort definiert ist, welches den Sicherheitsbedingungen der Domäne entspricht. Ansonsten wird zwar der Benutzer angelegt, aber der Import bleibt beim Setzen des nicht konformen Kennworts stehen.

VBS

Passwortlisten-Erstellung per VBA unter Excel

22. Februar 20121. April 2012 Daniel Lensing Keine Kommentare

Zur Erstellung von Passwörtern unter Excel habe ich am gestrigen Abend ein VBA-Skript erstellt, bei den man die Anzahl der Passwörter sowie auch die Anzahl der Zeichen bei jedem Aufruf definieren kann. Desweiteren können die zu nutzenden Ieichen beim Passwort ebenfalls editiert werden.

Sub PasswortErstellung()
 
  Dim myArray As Variant
  myArray = Array("", 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, "A", "B", _
            "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
            "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
            "a", "b", _
            "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", _
            "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", _
            ":", "-", "_", "!", "§", "$", "%", "&amp;", "/", "(", _
            ")", "=", "?", "#", "+")
 
  Dim VarAnzahl2 As Integer
  VarAnzahl2 = UBound(myArray)
 
  Dim VarAnzahl As Variant
  VarAnzahl = Application.InputBox("Anzahl der zu generierenden Passwörter:", "Passwort-Erstellung", 10, , , , , 1)
 
  Dim VarLaenge As Variant
  VarLaenge = Application.InputBox("Wieviele Zeichen soll das Passwort haben?", "Passwort-Erstellung", 8, , , , , 1)
 
  Dim VarColumn As Integer
  Dim VarPassword As Integer
  Dim VarRow As Integer
  Dim StrgPassword As String
 
  If Not TypeName(VarAnzahl) = "Boolean" Then
    Randomize
    VarColumn = ActiveCell.Column
    VarRow = ActiveCell.Row
    For VarRow = VarRow To VarRow + VarAnzahl
      For VarPassword = 1 To VarLaenge
        StrgPassword = StrgPassword &amp; myArray(Int(VarAnzahl2 * Rnd + 1))
      Next VarPassword
      If Application.WorksheetFunction.CountIf(ActiveCell.EntireColumn, StrgPassword) = 0 Then
        ActiveSheet.Cells(VarRow, VarColumn).Value = StrgPassword
      End If
      StrgPassword = ""
    Next VarRow
  End If
End Sub

Die Passwörter werden ab der Zeile geschrieben, die als aktiv makiert ist.

VBA

Exchange-Kontakte per VBS importieren

23. Juni 201120. Juni 2012 Daniel Lensing Keine Kommentare

Aufgrund einer Anforderung eines Kundenauftrags mussten bei über 600 Benutzern Mail-Weiterleitungen eingerichtet werden, damit die Nachrichten im alten sowie im neuen Mail-System verarbeitet werden. Aus diesem Grund mussten in der alten Umgebung eine entsprechende Anzahl von Mail-Kontakten angelegt werden. Da dieses manuell recht langwierig gewesen wäre, habe ich das folgende Skript von „Dani“ gefunden. Dieses muss einfach in eine VBS-Datei kopiert werden:

'##########################################################################
'Autor:&nbsp;Dani
'Aufgabe:&nbsp;Aus einer Exceltabelle im Exchange externe Kontakt erstellen
 
'Version:
'0.1 - Namensgebung einheitlich dargestellt
'0.2 - Dialogbox zur Abfrage der Exceltabelle eingebaut
'0.3 - Überprüft, ob Kontakt schon vorhanden ist
'0.4 - In der Abfrage, ob die E-Mailadresse schon AD vorhanden ist, war die Abfrage falsch.
 
'Variablen
'##########################################################################
Dim objobjExcel, objOpenDialog, objOU, objContact, objRecip
Dim strVorname, strNachname, strEmail, strDesc
 
' Dialogbox - Auswahl der Exceltabelle, die eingelesen werden soll
'##########################################################################
do
Set objOpenDialog = CreateObject("SAFRCFileDlg.FileOpen")
intReturn = objOpenDialog.OpenFileOpenDlg
 
If intReturn Then
Else
WScript.Echo "Script wird beendet!"
WScript.Quit
End If
 
Loop While objOpenDialog.FileName = ""
 
'Die entsprechende Datei wird geöffent
'##########################################################################
Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Workbooks.Open objOpenDialog.FileName
 
'Zeilennummer der ersten Datenzeile
i = 2
Do While objExcel.Worksheets(1).Cells(i,3).Value &lt;&gt; ""
strVorname &nbsp;= objExcel.Worksheets(1).Cells(i,1).Value
strNachname = objExcel.Worksheets(1).Cells(i,2).Value
strEmail &nbsp;= objExcel.Worksheets(1).Cells(i,3).Value
strDesc &nbsp;= objExcel.Worksheets(1).Cells(i,4).Value
 
' Organisationseinheit, in der ide Kontake erzeugt werden sollen
Set objOu = GetObject("<a href="ldap://ou=Kontakte,dc=familie-wydler,dc=local">LDAP://ou=Kontakte,dc=domain,dc=local</a>")
 
'Überprüfen, ob eine Kontakt schon vorhanden ist und setzt dem entsprechend die Variable
' True - E-Mailadresse existiert bereits
' False - E-Mailadresse nicht vorhanden
emailExists = False
 
For Each adcontact In objOu
If LCase(CStr(adcontact.targetAddress)) = LCase(CStr("SMTP:"&amp; strEmail)) Then
emailExists = True
Exit For
End If
Next
 
'Erzeugt die einzelnen Kontakte
If Not emailExists Then
 
'Erzeugt die einzelnen Kontakte
Set objContact = objOu.Create("contact", "cn="&amp; strVorname &amp;" "&amp; strNachname)
objContact.mailNickName = strVorname &amp;" "&amp; strNachname
objContact.displayName = strVorname &amp;" "&amp; strNachname
objContact.targetAddress = strEmail
objContact.givenName = strVorname
objContact.sn = strNachname
 
'Setzt nur die Beschreibung, wenn das Excelfeld nicht leer ist
If strDesc &lt;&gt; "" Then
objContact.description= strDesc
End If
 
'Hinterlegt im Reiter "E-Mail Adressen" der Benutzereigenschaften die E-Mailadresse
Set objRecip = objContact
objRecip.MailEnable "SMTP:" &amp; strEmail
objContact.SetInfo
Else
WScript.echo "Doppelter Kontakt - "&amp; strVorname &amp;", "&amp; strNachname &amp;"!"
End If
 
'Nächste Excelzeile
i = i + 1
Loop
 
'Setzt das "gespeichert" - Flag. Somit entfällt die Abfrage beim Beenden
objExcel.ActiveWorkbook.Saved = True
 
'Exceltabelle schließen / beenden
objExcel.Application.Quit
 
'Script beenden
'##########################################################################
WScript.Echo "Kontakte erfolgreich angelegt!"
WScript.Quit

Quelle: http://www.administrator.de/index.php?content=59212

Nun muss man im Skript nur die OU angeben, in der die Kontakte erstellt werden sollen und die Exceltabelle vorbereiten nach dem Design:

Spalte 1: Vorname
Spalte 2: Nachname
Spalte 3: E-Mail-Adresse
Spalte 4: Beschreibung (falls benötigt)

Die Tabelle sollte allerdings dieses nicht als ÜBerschriften haben, da diese sonst auch als Kontakt angelegt werden.

Exchange Server, VBS

E-Mail mit Anhang versenden über VBA

19. Mai 20111. April 2012 Daniel Lensing 15 Kommentare

Gestern bekam ich eine Anfrage, ob man eine E-Mail aus Excel versenden kann in der das Dokument als Anhang eingefügt ist.

Zu dieser Anforderung kann man folgenden Code verwenden:

Sub Mailversand()
Dim Nachricht As Object, OutlookApplication As Object
Set OutlookApplication = CreateObject("Outlook.Application")
Dim Anhang As String
Anhang = ThisWorkbook.FullName
Set Nachricht = OutlookApplication.CreateItem(0)
With Nachricht
.To = "mailadresse@domain.tld"
.Subject = "Betreff "
.attachments.Add Anhang
.Body = "Mailtext" &amp; vbCrLf &amp; vbCrLf
.Display
'.Mail.Send
End With
Set OutlookApplication = Nothing
Set Nachricht = Nothing
End Sub

Wenn man das Apostroph vor dem Befehl „.Mail.Send“ entfernt, wird die Mail direkt versandt.

VBA