Kategorien
Scripte

Excel2LDIF für den Directory Import

CSS Programming Image

Ziel:

Das Script wandelt eine Excel Tabelle in das LDIF Format um, zum weiteren Import.

Private Sub Excel2LDIF_Click()

'LDIF Ausgabe aus Excelliste
Dim oAs, oUser As Object
Dim xlApp As Object
Dim zaehler
Dim ADSI As Object
Dim OUTeil(256) As String

'On Error Resume Next

Set xlApp = CreateObject(pfad_tabelle.Caption)
xlApp.Application.Visible = False
xlApp.Windows(1).Visible = False

On Error Resume Next

With CommonDialog1
  .CancelError = True
  .Flags = cdlOFNOverwritePrompt
  .Filter = "Textdateien (*.LDIF)|*.LDIF"
  .ShowSave
  If .FileName <> "" Then
    F = FreeFile
    Open .FileName For Output As #F
  End If
End With

' Ermittlung der Anzahl Datensaetze und Prüfung
Fehleranzahl = 0 ' Fehleranzahl

Kontrollfeld.Text = Kontrollfeld.Text & "Prüfung !!!" & vbCrLf
AnzahlDatensaetze = 2
While (xlApp.Worksheets(1).Range("A" & AnzahlDatensaetze).Value) <> ""
  If Trim(xlApp.Worksheets(1).Range("C" & AnzahlDatensaetze).Value) = "" Then
    Fehleranzahl = Fehleranzahl + 1
  End If
  If Trim(xlApp.Worksheets(1).Range("D" & AnzahlDatensaetze).Value) = "" Then
    Fehleranzahl = Fehleranzahl + 1
  End If
  If Trim(xlApp.Worksheets(1).Range("E" & AnzahlDatensaetze).Value) = "" Then
    Fehleranzahl = Fehleranzahl + 1
  End If
  If Trim(xlApp.Worksheets(1).Range("G" & AnzahlDatensaetze).Value) = "" Then
    Fehleranzahl = Fehleranzahl + 1
  End If
  AnzahlDatensaetze = AnzahlDatensaetze + 1
Wend

If Fehleranzahl > 0 Then
  Antwort = MsgBox("Anzahl fehlerhafter Datensätze: " & Fehleranzahl, vbYesNo + vbExclamation, "Wollen Sie eine LDIF - Ausgabe erstellen?")
  If Antwort = vbOK Then
  Else
    Print #F, Kontrollfeld.Text
    Close #F
    Unload Form1
    Exit Sub
    xlApp.Application.Quit
  End If
End If

' Start Bearbeitung
zaehler = 2
While (xlApp.Worksheets(1).Range("A" & zaehler).Value) <> ""

'Refresh der Anzeige
Form1.Refresh
Kontrollfeld.Refresh

'Schreibe LDIF

'Variablen belegen
'---------------------------------------------------------------------------
    'Variable Werte aus Tabelle --------------------------------------------

    Datum = Format$(Now, "yy.mm.dd")
    Tag = Right(Datum, 2)
    Monat = Mid(Datum, 4, 2)
    Jahr = Left(Datum, 2)
    Zeit = Format$(Now, "hh:nn:ss")
    Min = Mid(Zeit, 4, 2)
    St = Left(Zeit, 2)

    If zaehler > 9 Then
      employeeNumber = "E" & Jahr & Monat & Tag & St & zaehler & "1"
    Else
      employeeNumber = "E" & Jahr & Monat & Tag & St & Min & zaehler
    End If

    sn = Trim(xlApp.Worksheets(1).Range("C" & zaehler).Value) 'Nachname
    givenName = Trim(xlApp.Worksheets(1).Range("D" & zaehler).Value) 'Vorname

    ' - berechneter Wert aus Tabelle ---------------------------------------
    Print #F, "dn: cn=" & sn & " " & givenName & " " & employeeNumber & "," & "cn=Users,cn=XXXXXX"
    Print #F, "cn: " & sn & " " & givenName & " " & employeeNumber 
    Print #F, "employeeNumber: " & employeeNumber
    Print #F, "sn: " & Trim(xlApp.Worksheets(1).Range("C" & zaehler).Value) 
    Print #F, "givenName: " & Trim(xlApp.Worksheets(1).Range("D" & zaehler).Value)

    ' Prüfung auf Firma vorhanden wenn ja dann Excelliste wenn nein ="extern"

    If UCase(Trim(xlApp.Worksheets(1).Range("H" & zaehler).Value)) = "" Then
      Print #F, "Company: EXTERN 'Firma =xxx"
    Else
      Print #F, "Company: " & UCase(Trim(xlApp.Worksheets(1).Range("H" & zaehler).Value)) 
    End If
    Print #F, "Salutation: " & Trim(xlApp.Worksheets(1).Range("B" & zaehler).Value)

    OU = UCase(Trim(xlApp.Worksheets(1).Range("E" & zaehler).Value))
    K = 1
    OUTeil(K) = UCase(Trim(xlApp.Worksheets(1).Range("E" & zaehler).Value)) '(1)
    K = K + 1
    While (InStrRev(OU, "-")) <> 0
      Position = (InStrRev(OU, "-"))
      OUTeil(K) = Left(OU, Position - 1)
      OU = Left(OU, Position - 1)
      K = K + 1
    Wend
    OU = "OU: ou="
    For J = 1 To K - 1
    If J = K - 1 Then
      OU = OU & OUTeil(J)
    Else
      OU = OU & OUTeil(J) & ",ou="
    End If
    Next J
    OU = OU & ",o=xxx,cn=xxx"
    Print #F, OU

    'Kostenstelle
    Print #F, "Kostenstelle: " & UCase(Trim(xlApp.Worksheets(1).Range("G" & zaehler).Value)) 'Kostenstelle

    ' ADS User Typ auswerten -> Base OU bestimmen START
    ADOU = UCase(Trim(xlApp.Worksheets(1).Range("K" & zaehler).Value)) 
    Select Case ADOU
    Case "1"
      ADOU = "OU=Users,"
    Case "2"
      ADOU = "OU=Users,"
    Case "3"
      ADOU = "OU=Users,"
    Case Else
      ADOU = "OU=Users,"
    End Select
    Print #F, "ADOU: " & ADOU

    Print #F, "AD: " & Trim(xlApp.Worksheets(1).Range("I" & zaehler).Value) 'AD Status

    Print #F, vbCrLf

  zaehler = zaehler + 1
Wend
Close #F
xlApp.Application.Quit
End Sub

Von Michael

wohnhaft in München
arbeite bei der Landeshauptstadt München

Schreiben Sie einen Kommentar

Ihre E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert