Excel2LDIF

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

DSL Test

WICHTIG ! Dieser Test kann nicht als Nachweis gegenüber Ihrem DSL Anbieter verwendet werden. Die Messung unterliegt Schwankungen. Wir übernehmen keine Gewühr oder Haftung auf das Ergebnis. Im Zweifel lassen Sie die Leitungsgeschwindigkeit von Ihrem DSL Provider direkt messen.

DSL Test

Klicken Sie unten auf "Speedtest starten" um die aktuelle DSL Geschwindigkeit zu messen. Der Speedtest dauert ca. 10 Sekunden.


(c) Suchmaschinen-Online.de - DSL Test

neues Joomla Modul - Akkuleistung berechnen für Joomla

Im Dowmload Bereich steht ein neues Jommla Modul - Akku Berechnung. Falls Fragen dazu sind... Diese E-Mail-Adresse ist vor Spambots geschützt! Zur Anzeige muss JavaScript eingeschaltet sein!

Akku Berechnung 1.6

Akku Leistung





Transfer Calc 1.6

Volumen, Bandbreite zu Zeit