Quellcode einfügen excel 2003 - vba

Mitglied: Dudelidude

Dudelidude (Level 1) - Jetzt verbinden

14.07.2011 um 11:26 Uhr, 4826 Aufrufe, 2 Kommentare

Hallo liebe Leute!

Es geht um folgendes.Ich hab einen Quellcode aus einer anderen Abteilung bekommen, der es mir ermöglicht die Adresssuche im Outlook in einem Excelsheet zu öffnen.
Allerdings versteh ich den Code nicht und weiß nicht wo ich den reinkopieren soll.

Er soll in das sheet "WorkingGroupList". Wie kann ich den Code darein kopieren? Der Clue ist,dass ich das Makro nicht einer Schaltfläche zuweisen muss,sonder es immer da funktioniert,wo die Zeile ="x" ist und die Spalte ="y" !

Hoffe jemand kann mir das erklären


Das ist der Code:

Sub ADNameQuery(Name As String, iRow As Long, iCol As Long)

'Es folgen Makros für das Aufrufen des Outlook Adressbuchs

Dim GC As Object, Child As Object, rootDomaine As Object, objConnection As Object
Dim objCommand As Object, objRecordSet
Set GC = GetObject("GC:")
For Each Child In GC
Set rootDomain = Child
Next
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<GC://" & rootDomain.Name & ">;(samAccountName=" & Name & ");displayName,telephoneNumber,mobile,mail,sn,givenName,department,physicalDeliveryOfficeName,co;subTree"
Set objRecordSet = objCommand.Execute
If Not objRecordSet.EOF Then
Cells(iRow, iCol).Value = objRecordSet.Fields("sn").Value
Cells(iRow + 1, iCol).Value = objRecordSet.Fields("givenName").Value
Cells(iRow + 4, iCol) = objRecordSet.Fields("mail").Value
Cells(iRow + 5, iCol).Value = objRecordSet.Fields("department").Value
Cells(iRow + 2, iCol).Value = objRecordSet.Fields("telephoneNumber").Value
Cells(iRow + 3, iCol).Value = objRecordSet.Fields("mobile").Value
'Cells(iRow, iCol).Value = objRecordSet.Fields("displayName").Value
'Cells(iRow + 7, iCol).Value = objRecordSet.Fields("physicalDeliveryOfficeName").Value
'Cells(iRow + 6, iCol).Value = objRecordSet.Fields("co").Value
Cells(iRow - 1, iCol).Select
End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Nam As String, iRow As Long, iCol As Long, Memo As String
If Target.Cells.Count > 1 Then GoTo ende
iRow = Target.Row
iCol = Target.Column
If Cells(1, iCol).Value = "x" And Cells(iRow, 1).Value = "y" Then
Target.Value = "Bitte warten!"
Call Wer(Memo, Nam)
Target.Value = ""
End If
If Memo <> "" Then Call ADNameQuery(Memo, iRow, iCol)
ende:
End Sub
Sub Wer(ByRef Memo As String, ByRef Nam As String)
Dim objRecipColl As Object, OutLookObject As Object, NmSpace As Object
Set OutLookObject = CreateObject("Outlook.Application")
Set NmSpace = CreateObject("MAPI.Session")
If Not NmSpace Is Nothing Then
NmSpace.logon "", "", False, False
End If
Memo = ""
Nam = ""
On Error GoTo ende
Set objRecipColl = NmSpace.AddressBook()
Memo = Memoid(objRecipColl.Item(1).Address)
Nam = objRecipColl.Item(1).Name
ende:
Err.Clear
On Error GoTo 0
End Sub
Function Memoid(Nam As String) As String
Dim i As Long, j As Long
j = 1
nochmal:
i = InStr(j, Nam, "cn=", vbTextCompare)
If i > 0 Then
j = i + 1
GoTo nochmal
End If
If j > 1 Then
Memoid = Right(Nam, Len(Nam) - j - 1)
Else
Memoid = ""
End If
End Function
Mitglied: 83928
83928 (Level 1)
14.07.2011 um 12:46 Uhr
Ohne den Code betrachtet zu haben - den VBA-Editor öffnest Du bei E2003 über ->Extras->Makros->Visual Basic Editor. Da gehört der Code rein. Deine Arbeitsmappe sollte ein Tabellenblatt namens WorkingGroupList beinhalten....
Bitte warten ..
Mitglied: Dudelidude
14.07.2011 um 13:27 Uhr
Ja das hab auch so gemacht,mein Fehler war, dass ich den Code in ein Modul gelegt habe und es aber nur funktioniert,wenn man den Code in das entsprechende Tabellenblatt legt. Dummer Fehler, der viel Zeit und Nerven kostete.
Trotzdem Danke für die Hilfe!
Bitte warten ..
Heiß diskutierte Inhalte
Microsoft
Mitteilung an alle bei Störungen in der IT
gelöst David.B2D45Vor 1 TagFrageMicrosoft31 Kommentare

Hallo Forum, ich bin auf der Suche nach einem Programm / Tool mit dem ich Text (Laufschrift) auf allen (gewünschten) PC's / Benutzer im ...

Exchange Server
Exchange Zero Day Hack - Wie entfernen?
gelöst mtaiitVor 12 StundenFrageExchange Server18 Kommentare

Hallo, bei mir hat es einige Kundenserver getroffen Weiß einer wie ich diese WebShells wieder loswerde? Das löschen der betroffenen .aspx Dateien wird wohl ...

E-Mail
Kann man mit SPF Mails für eine Domäne vollständig verbieten?
gelöst StefanKittelVor 1 TagFrageE-Mail17 Kommentare

Hallo, viele Firmen haben ja zusätzliche Domänen. Als Web- und oder Mail-weiterleitung. Es werden also niemals Emails damit gesendet werden. kann man mit einem ...

Server-Hardware
Firmware-Updates auf Servern
redhorseVor 1 TagFrageServer-Hardware7 Kommentare

Guten Morgen, die Server-Hersteller stellen bekanntlich regelmäßig Firmware- und Treiberupdates für deren Serverhardware bereit, diese können z.B. bei Dell als Dell EMC Server Update ...

Linux
Windows auf Dualbootrechner entfernen und Linux die komplette Platte zur Verfügung stellen
N8chtfalterVor 1 TagFrageLinux6 Kommentare

Hallo Linux Profis, ich habe einen Laptop auf dem ursprünglichen Windows 10 installiert war, und ist, ich habe vor einem Jahr Ubuntu testhalber als ...

Router & Routing
Routing öffentliche IP-Adresse-Traffic per BGP im internal-Network
gelöst jescheroVor 23 StundenFrageRouter & Routing2 Kommentare

Guten Abend alle zusammen, ich habe ein kleines Problem beim Routing in pfSense. Mein aktuelles Aufbau ist folgenden: Ich habe eine pfSense-VM und zwei ...

Windows Server
Domänenadmin kann kein Zertifikat anfordern
noodellsVor 1 TagFrageWindows Server6 Kommentare

Hallo Zusammen, ich habe ein Problem beim Finden einer Einstellung. Zuerst einmal der Stand: Es gibt eine Windows CA und Domaincontroller und alles funktionierte ...

Exchange Server
Windows Server 2019 + Exchange Server 2019 (Probleme mit Pop3)
gelöst aristonVor 1 TagFrageExchange Server4 Kommentare

Hallo zusammen, ich habe gerade angefangen, mit dem Exchange Server 2019 in der Demoversion zu arbeiten und folge Schritt für Schritt bei der notwendigen ...