Og så koden:
Public rs
Public afsName, afsTlf, afsMail, afsTitle, afsMobile, afsDistName As String
Sub find_bruger()
' Create the connection and command object.
Set oConnection1 = CreateObject("ADODB.Connection")
Set oCommand1 = CreateObject("ADODB.Command")
' Open the connection.
oConnection1.Provider = "ADsDSOObject" ' This is the ADSI OLE-DB provider name
oConnection1.Open "Active Directory Provider"
' Create a command object for this connection.
Set oCommand1.ActiveConnection = oConnection1
' Compose a search string.
oCommand1.CommandText = "select sAMAccountName, distinguishedName, name, telephoneNumber, mail, title, l, mobile " & _
"from '
LDAP://mailserveren'" & _
"WHERE objectCategory='Person'" & _
"AND objectClass='user'" & _
"AND department=100" & _
"OR department=210" & _
"OR department=220" & _
"OR department=230" & _
"OR department=300" & _
"OR department=310" & _
"OR department=400" & _
"OR department=410" & _
"OR department=700"
' Execute the query.
Set rs = oCommand1.Execute
' Hvilken bruger skal markeres
Dim wshNetwork
Set wshNetwork = CreateObject("WScript.Network")
user = wshNetwork.UserName
'Domain = wshNetwork.userdomain
'computer = wshNetwork.ComputerName
'--------------------------------------
' Navigate the record set
' select the user
'--------------------------------------
While Not rs.EOF
startBoks.cbAfsender.AddItem rs.Fields("name")
If LCase(user) = LCase(rs.Fields("sAMAccountName")) Then
For i = 0 To cbAfsender.ListCount - 1
If cbAfsender.List(i) = rs.Fields("name") Then
cbAfsender.ListIndex = i
Exit For
End If
Next
End If
' Debug.Print rs.Fields("sAMAccountName")
' Debug.Print rs.Fields("name") & ", " & rs.Fields("telephoneNumber") & ", " & rs.Fields("mail") & ", " & rs.Fields("title") & ", " & rs.Fields("facsimileTelephoneNumber") & ", " & rs.Fields("mobile") & ", ---- " & rs.Fields("distinguishedName")
rs.MoveNext
Wend
End Sub
Private Sub cbAfsender_Change()
rs.MoveFirst
Dim found As Boolean
found = False
While (Not found) And (Not rs.EOF)
If LCase(cbAfsender.Value) = LCase(rs.Fields("name")) Then
found = True
Me.afsName = rs.Fields("name")
Me.afsTlf = rs.Fields("telephoneNumber")
Me.afsMail = rs.Fields("mail")
Me.afsTitle = rs.Fields("title")
Me.afsMobile = rs.Fields("mobile")
Me.afsDistName = rs.Fields("distinguishedName")
Dim strAfsender As String
If Not IsNull(Me.afsName) Then
strAfsender = Me.afsName
End If
If Not IsNull(Me.afsTitle) Then
strAfsender = strAfsender & vbCrLf & Me.afsTitle
End If
If Not IsNull(Me.afsMail) Then
strAfsender = strAfsender & vbCrLf & Me.afsMail
End If
If Not IsNull(Me.afsTlf) Then
strAfsender = strAfsender & vbCrLf & Me.afsTlf
End If
If Not IsNull(Me.afsMobile) Then
strAfsender = strAfsender & vbCrLf & Me.afsMobile
End If
Me.tbAfsenderdata = strAfsender
End If
rs.MoveNext
Wend
End Sub
Private Sub cdAnnuller_Click()
startBoks.Hide
Application.Quit Savechanges:=False
End Sub
Private Sub opret_Click()
'afsender
Dim strAfsender As String
If Not IsNull(Me.afsName) Then
strAfsender = Me.afsName
End If
If Not IsNull(Me.afsTitle) Then
strAfsender = strAfsender & vbCrLf & Me.afsTitle
End If
If Not IsNull(Me.afsMail) Then
strAfsender = strAfsender & vbCrLf & Me.afsMail
End If
If Not IsNull(Me.afsTlf) Then
strAfsender = strAfsender & vbCrLf & Me.afsTlf
End If
If Not IsNull(Me.afsMobile) Then
strAfsender = strAfsender & vbCrLf & Me.afsMobile
End If
ActiveDocument.FormFields("afsender").Range.Text = strAfsender
'ActiveDocument.FormFields("afsender").Range.Text = Replace(strAfsender, vbCrLf & vbCrLf, "")
If startBoks.tbFirma.Value = "" Then
MsgBox "Du har ikke udfyldt firmanavnet"
ElseIf startBoks.tbAdresse.Value = "" Then
MsgBox "Du har ikke udfyldt firmaadressen"
ElseIf startBoks.tbBy.Value = "" Then
MsgBox "Du har ikke udfyldt postnr. og/eller by"
ElseIf startBoks.tbModtager.Value = "" Then
MsgBox "Du har ikke udfyldt modtageren af brevet"
ElseIf startBoks.tbOverskrift.Value = "" Then
MsgBox "Du har ikke givet brevet en overskrift"
ElseIf startBoks.tbModtager.Value = "" Then
MsgBox "Du har ikke skrevet selve brevet"
Else
'modtagerfimra
Dim strModtager As String
strModtager = startBoks.tbFirma.Value & vbCrLf & startBoks.tbAdresse.Value & vbCrLf _
& startBoks.tbBy.Value
ActiveDocument.FormFields("modtager").Range.Text = strModtager
'modtagerperosn
ActiveDocument.FormFields("person").Range.Text = "Att.: " & startBoks.tbModtager.Value
'overskrift
ActiveDocument.FormFields("overskrift").Range.Text = startBoks.tbOverskrift.Value
'overskrift
ActiveDocument.FormFields("brev").Range.Text = startBoks.tbBrev.Value
startBoks.Hide
End If
End Sub
