Outlook Wählhilfe (Makro) ohne Box zu modifizieren

[michat]

Hi MarcoMarco,

danke für Deine Antwort. Das Problem ist nur, dass man mit einem schnurlosen Telefon nicht wirklich "abheben" kann.... Es geht nur über den Umweg in dem man den Lautsprecher aktiviert (Freisprech-Taste).

Gruss
Michat

 

[Kruemelino]

Drück mal bei dem Hörer ca. 2 Sekunden auf den grünen Hörer. Eigentlich sollte da "Abgehoben" werden. (Hab ebenfalls Siemens Telefone)
Mit dem Versionscheck werden dir die Dateien genannt, die sich geändert haben. Dann musst du diese dateien entfernen und kannst die neuen installieren. Dabei ist zu achten, dass der Anrufmonitor ausgeschaltet ist.

 

[Kruemelino]

v2.22 ist draußen:
Nochmal eine kurze Erläuterung zu den Änderungen:
Wenn man auf eine Email kickt und "Wählen" dann wurde der Absender in den Kontakten gesucht. Leider funktioniert, das nur wenn die Email gleich ist. [email protected] != [email protected]
Das ist aber im Sinne einer Email-adresse gleich. Das habe ich gefixt.
Das nächste war folgendes: Die Pingroutine hat sich irgendwie verschluckt und die eigene Datei nicht wiedergefunden. Das wurde durch einen User gelöst. Ich habe die Änderung mit veröffentlicht. Danke an dieser Stelle
Ansonnsten war wieder der übliche Kleinkram.
Das Einloggen beim Wählen wird jetzt erzwungen. Das 15 Minütige Timeout der FB scheint nicht immer zu funktionieren.

 

[x-herbert]

V 2.22 an Outlook 2000: Kontakte

Frage: wenn ich bei einer markierten eMail auf "Wählen" gehe, zeigt das Programm "Kein Eintrag zur eMail xxx gefunden" - sucht das Programm nur im "Standard-Kontakteordner"?

Gruss x-herbert

 

[x-herbert]

Bugs?

Rechner: XP Pro mit Outlook 2000 und Version 2.22

1.) die IP meines Rechners wird nicht angezeigt - is das wichtig??
2.) wenn ich einen Kontak markiere und "Wählen" drücke kommt eine Fehlermeldung zu der Zeile
CreateObject("Outlook.Application").GetNamespace("MAPI").GetItemFromID(KontaktID)

aus Function Wählbox(...
Die Fehlermeldung kommt dann, wenn der Kontakt bzw. Kontakteordner sich nicht im "Standardordner" (Persönlicher Ordner) befindet

Gruss x-herbert

 

[Kruemelino]

Das Makro durchsucht nur das Standard-Adressbuch. Wenn du mehrere hast, dann wird nur eins durchsucht. Leg einfach Unterordner an, die werden durchsucht. Mit der IP gibt es ein paar probleme. Wenn der Anrufmonitor funktioniert, ist es nicht so schlimm.

 

[x-herbert]

IP-Adresse

@Krumelino

ich habe im Netz mal nach IP-Adresse + VB gesucht und bin natürlich mehrfach auf den eingesetzten Code gestossen - warum bei mir immer nur 0.0.0.0 angezeigt wird, zeigte sich über ein ähnliches Projekt

Option Explicit

'IP-Adressen ermitteln
Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" (pTcpTable As Any, pdwSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Private Const MAX_ADAPTER_NAME_LENGTH         As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH  As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH      As Long = 8

Private Type IP_ADDRESS_STRING
    ipAddr(0 To 15)  As Byte
End Type

Private Type IP_MASK_STRING
    IpMask(0 To 15)  As Byte
End Type

Private Type IP_ADDR_STRING
    dwNext     As Long
    ipaddress  As IP_ADDRESS_STRING
    IpMask     As IP_MASK_STRING
    dwContext  As Long
End Type

Private Type IP_ADAPTER_INFO
  dwNext                As Long
  ComboIndex            As Long
  sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3))        As Byte
  sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
  dwAddressLength       As Long
  sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1))       As Byte
  dwIndex               As Long
  uType                 As Long
  uDhcpEnabled          As Long
  CurrentIpAddress      As Long
  IpAddressList         As IP_ADDR_STRING
  GatewayList           As IP_ADDR_STRING
  DhcpServer            As IP_ADDR_STRING
  bHaveWins             As Long
  PrimaryWinsServer     As IP_ADDR_STRING
  SecondaryWinsServer   As IP_ADDR_STRING
  LeaseObtained         As Long
  LeaseExpires          As Long
End Type



Private Function LocalIPAddresses() As String
On Error Resume Next
'für API-Aufrufe
Dim cbRequired  As Long
Dim buff()      As Byte
Dim Adapter     As IP_ADAPTER_INFO
Dim AdapterStr  As IP_ADDR_STRING
'allgemeine Variablen
Dim ptr1        As Long
Dim sIPAddr     As String
Dim sAllAddr    As String
   
Call GetAdaptersInfo(ByVal 0&, cbRequired)
If cbRequired > 0 Then
    ReDim buff(0 To cbRequired - 1) As Byte
    If GetAdaptersInfo(buff(0), cbRequired) = 0 Then
        'Zeiger (Pointer) zu den gespeicherten Daten (buff) ermitteln
        ptr1 = VarPtr(buff(0))
        'ptr1 ist 0 wenn keine weiteren Adapter vorhanden sind
        Do While (ptr1 <> 0)
            'aktuellen Zeiger auf Datenstrucktur (Adapter) zuweisen
            CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
            With Adapter
                'IP-Adresse des adapters auslesen
                sIPAddr = TrimNull(StrConv(.IpAddressList.ipaddress.ipAddr, vbUnicode))
                'und Name des Adapters durch das Ascii-Zeichen 1 getrennt, anfügen
                sAllAddr = sAllAddr & sIPAddr & Chr(1) & TrimNull(StrConv(.sDescription, vbUnicode)) & vbCrLf
                'Poiner auf nächsten Adapter setzen
                ptr1 = .dwNext
            End With
        Loop
    End If
End If

'letzes vbcrlf entfernen, wenn Adapter gefunden wurden
 If Len(sAllAddr) > 0 Then sAllAddr = Left(sAllAddr, Len(sAllAddr) - 2)
'und Liste der Adapter mit ihren IP-Adressen ausgeben
 LocalIPAddresses = sAllAddr
End Function


Private Function TrimNull(ByVal str As String) As String
 On Error Resume Next

 TrimNull = Trim(Left(str, InStr(str, Chr(0)) - 1))
End Function


Private Sub cmdRefresh_Click()
'IP-Adressen incl. Adapter ermitteln
'und das Ascii-Zeichen 1 durch das Trennzeichen " / " ersetzen
 txtIPs.Text = Replace(LocalIPAddresses, Chr(1), " / ")
End Sub


Private Sub Form_Load()
 'Anzeige aktualisieren
 Call cmdRefresh_Click
End Sub

Button: cmdRefresh
Textfeld: txtIPs

Hier werden nun alle IPs des PC angezeigt - und siehe da: die erste stammt von meinem DVB-T Adapter mit IP 0.0.0.0...

Gruss x-herbert

 

[marcomarco]

@x-herbert:
Ändere doch mal die Reihenfolge der Netzwerkkarten in der Netzwerkumgebung:
Eigenschaften der Netzwerkumgebung->Erweitert->Erweiterte Einstellungen.
Unter Verbindungen stelle Deine Netzwerkarte als erste Karte ein...

Gruß

MarcoMarco

 

[x-herbert]

Netzwerkkarten-Reihenfolge

@marcomarco

habs umgestellt => geht...

war mir bisher unbekannt, dass das geht - für was sollte die Reihenfolge noch gut sein???

Danke & Gruss
x-herbert

 

[marcomarco]

@x-herbert:

Die Bindungsreihenfolge der Netzwerkadapter hat was mit der Priorität zu tun, wie diese angesteuert werden. Ich kenne ein paar Programme, die ihre Lizensierung auf de Netzwerkkarte machen. Diese haben Probleme, wenn die Netzwerkkarte, auf die lizensiert wurde, nicht die erste ist.

Ich denke, ich werde mal schauen, ob es auch per VBA möglich ist, einen "Bindungsadapter" auszuwählen und dann davon die IP-Adresse auszulesen. Mal schauen, ob ich am WE dazu komme. Wahrscheinlich hat Kruemelino dank seines Programmiergeschickes eine Lösung schon vorher gefunden...

Gruß

MarcoMarco

 

[Kruemelino]

nene ich denke nicht, Bin mittten in der Prüfungszeit und werde so schnell nicht dazukommen.Ich habe volles Vertrauen in dein Programmiergeschick

 

[x-herbert]

IP-Adresse

@marcomarco

ich bin kein Netzwerk-Fuchs aber vielleicht kommt man mit etwas Logik ans Ziel:

Frage: wir suchen den Netzwerkadapter, der mit unserer FB kommuniziert

Bedingungen für diesen Netzwerkadapter:
* TCP/IP als Protokoll
* IP muss zur Fritzbox "passen", d.h.
- eine der eingetragenen IPs (können ja mehrere sein) muss aus dem gleichen Range wie FB sein oder
- der Standard-DNS muss aus Range wie FB sein (bei mir der Fall)

Frage vorweg: ist die IP des Rechners irgenwie wichtig oder ist das Ganze "akademischer Wissensgewinn" ;-)

Gruss x-herbert

 

[Kruemelino]

okay ich hab schnell was gebaut:

'IP-Adressen ermitteln
Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" (pTcpTable As Any, pdwSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Private Const MAX_ADAPTER_NAME_LENGTH         As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH  As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH      As Long = 8

Private Type IP_ADDRESS_STRING
    ipAddr(0 To 15)  As Byte
End Type

Private Type IP_MASK_STRING
    IpMask(0 To 15)  As Byte
End Type

Private Type IP_ADDR_STRING
    dwNext     As Long
    ipaddress  As IP_ADDRESS_STRING
    IpMask     As IP_MASK_STRING
    dwContext  As Long
End Type

Private Type IP_ADAPTER_INFO
  dwNext                As Long
  ComboIndex            As Long
  sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3))        As Byte
  sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
  dwAddressLength       As Long
  sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1))       As Byte
  dwIndex               As Long
  uType                 As Long
  uDhcpEnabled          As Long
  CurrentIpAddress      As Long
  IpAddressList         As IP_ADDR_STRING
  GatewayList           As IP_ADDR_STRING
  DhcpServer            As IP_ADDR_STRING
  bHaveWins             As Long
  PrimaryWinsServer     As IP_ADDR_STRING
  SecondaryWinsServer   As IP_ADDR_STRING
  LeaseObtained         As Long
  LeaseExpires          As Long
End Type


Function LocalIPAddress2FritzBox() As String
On Error Resume Next
'für API-Aufrufe
Dim cbRequired  As Long
Dim buff()      As Byte
Dim Adapter     As IP_ADAPTER_INFO
Dim AdapterStr  As IP_ADDR_STRING
'allgemeine Variablen
Dim ptr1        As Long
Dim sIPAddr     As String
Dim sAllAddr    As String

Dim FB_ADD      As String
Dim pos         As Long

FB_ADD = GetSetting("FritzBox", "Optionen", "TBFBAdr", "192.168.178.1")
pos = InStrRev(FB_ADD, ".", , vbTextCompare)
FB_ADD = Left(FB_ADD, pos)
Call GetAdaptersInfo(ByVal 0&, cbRequired)
If cbRequired > 0 Then
    ReDim buff(0 To cbRequired - 1) As Byte
    If GetAdaptersInfo(buff(0), cbRequired) = 0 Then
        'Zeiger (Pointer) zu den gespeicherten Daten (buff) ermitteln
        ptr1 = VarPtr(buff(0))
        'ptr1 ist 0 wenn keine weiteren Adapter vorhanden sind
        Do While Not ptr1 = 0
            'aktuellen Zeiger auf Datenstrucktur (Adapter) zuweisen
            CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
            With Adapter
                'IP-Adresse des adapters auslesen
                sIPAddr = TrimNull(StrConv(.IpAddressList.ipaddress.ipAddr, vbUnicode))
                'und Name des Adapters durch das Ascii-Zeichen 1 getrennt, anfügen
                If Not InStr(1, sIPAddr, FB_ADD, vbTextCompare) = 0 Then LocalIPAddress2FritzBox = sIPAddr
                'sAllAddr = sAllAddr & sIPAddr & vbNewLine
                'Poiner auf nächsten Adapter setzen
                ptr1 = .dwNext
            End With
        Loop
    End If
End If
End Function


Private Function TrimNull(ByVal str As String) As String
On Error Resume Next
TrimNull = Trim(Left(str, InStr(str, Chr(0)) - 1))
End Function

Der ganze Spaß wird über LocalIPAddress2FritzBox().
Funktion schaut ob in der LocalIP "192.168.178." steht.

 

[x-herbert]

IP; nicht-Standard-Kontakt

@Kruemelino

die IP-Geschichte werde ich mal testen...

Zurm Thema "warum kann ich nicht aus Kontakt wählen, wenn dieser nicht im 'Hauptvwezeichnis' liegt" bin ich auf die Schliche gekommen:

In der "Function Wählbox(KontaktID As String, TelNr As String)" felt dem Aufruf
With CreateObject("Outlook.Application").GetNamespace("MAPI").GetItemFromID(KontaktID)

die StoreID

mit folgendem Test "per Hand" geprüft

Function Wählbox(KontaktID As String, TelNr As String)
    ' macht alle Eintragungen in 'formWählbox'
    ' aus FritzBoxDial übernommen und überarbeitet
    ' Parameter:  KontaktID (String):  ID der Kontaktdaten des Anzurufenden
    '             TelNr (String):      Telefonnummer des Anzurufenden
    
    Dim alleTelNr         As Variant ' alle im Kontakt enthaltenen Telefonnummern
    Dim alleNrTypen       As Variant ' die Bezeichnungen der Telefonnummern
    Dim i As Long, iTelNr As Long    ' Zählvariablen
    Dim pos               As Long    ' Position innerhalb eines Strings
    Dim LandesVW          As String  ' eigene Landesvorwahl
    Dim MyStoreID As String
    
    MyStoreID = "0000000038A1BB1005E5101AA1BB08002B2A56C200005053545052582E444C4C00000000000000004E495441F9BFB80100AA0037D96E000000433A5C446F6B756D656E746520756E642045696E7374656C6C756E67656E5C737465696E68617264745C4C6F6B616C652045696E7374656C6C756E67656E5C416E77656E64756E6773646174656E5C4D6963726F736F66745C4F75746C6F6F6B5C313135303238363036316B656E2E70737400"
    
    LandesVW = GetSetting("FritzBox", "Optionen", "TBLandesVW", "0049")
    formWählbox.Tag = KontaktID
    ' Liste entleeren
    formWählbox.listTel.Clear
    iTelNr = 0
    ' Ist der Kontakt nicht vorhanden (z.B. Rückruf)?
    If Left(KontaktID, 2) = "-1" Then
        ' Ortsvorwahl vor die Nummer setzen, falls eine Rufnummer nicht mit "0" beginnt und nicht mit "11"
        ' (Rufnummern die mit "11" beginnen sind Notrufnummern oder andere Sondernummern)
        If Not Left(nurZiffern(TelNr, LandesVW), 1) = "0" And Not Left(nurZiffern(TelNr, LandesVW), 2) = "11" Then _
            TelNr = GetSetting("FritzBox", "Optionen", "TBVorwahl", "") & TelNr
        pos = InStr(KontaktID, ";")
        ' Fenstertitel setzen
        If Mid(KontaktID, 3, pos - 3) = "" Then
            formWählbox.Caption = "Anruf: " & TelNr
        Else
            formWählbox.Caption = "Anruf: " & Mid(KontaktID, 3, pos - 3)
        End If
        ' Liste füllen
        formWählbox.listTel.AddItem
        formWählbox.listTel.List(0, 0) = 1
        formWählbox.listTel.List(0, 2) = TelNr
    Else
        ' Welche Telefonnummerntypen sollen angezeigt werden?
        ' http://support.microsoft.com/kb/293152/
        ' http://www.pcreview.co.uk/forums/thread-1840160.php
        With CreateObject("Outlook.Application").GetNamespace("MAPI").GetItemFromID(KontaktID, MyStoreID)
            ' Fenstertitel setzen
            formWählbox.Caption = Replace("Anruf: " & .FullName & " (" & .CompanyName & ")", " ()", "", , , vbTextCompare)
            ' labelStatus initialisieren
            formWählbox.labelStatus.Caption = ""
            ' Die einzelnen Telefonnummern in ein Array packen
            alleTelNr = Array(.AssistantTelephoneNumber, .BusinessTelephoneNumber, _
                .Business2TelephoneNumber, .CallbackTelephoneNumber, .CarTelephoneNumber, _
                    .CompanyMainTelephoneNumber, .HomeTelephoneNumber, .Home2TelephoneNumber, _
                        .ISDNNumber, .MobileTelephoneNumber, .OtherTelephoneNumber, _
                            .PagerNumber, .PrimaryTelephoneNumber, .RadioTelephoneNumber)
            ' Die deutsche Bezeichnung der Nummerntypen
            ' für Anzeigezwecke auch in ein Array packen.
            alleNrTypen = Array("Assistent", "Geschäftlich", "Geschäftlich2", "Rückmeldung", _
                "Auto", "Firma", "Privat", "Privat2", "ISDN", "Mobiltelefon", "Weitere", _
                    "Pager", "Haupttelefon", "Funkruf")
        End With
        ' Liste füllen
        For i = LBound(alleTelNr) To UBound(alleTelNr)
            If Not alleTelNr(i) = "" Then
                ' Wenn die Telefonnummer nicht leer ist, dann in die Liste hinzufügen
                formWählbox.listTel.ColumnCount = 3
                formWählbox.listTel.AddItem
                formWählbox.listTel.List(iTelNr, 0) = iTelNr + 1
                'Ortsvorwahl vor die Nummer setzen, falls eine Rufnummer nicht mit "0" beginnt und nicht mit "11"
                '(Rufnummern die mit "11" beginnen sind Notrufnummern oder andere Sondernummern)
                If Not Left(nurZiffern(alleTelNr(i), LandesVW), 1) = "0" And Not Left(nurZiffern(alleTelNr(i), LandesVW), 2) = "11" Then _
                    alleTelNr(i) = GetSetting("FritzBox", "Optionen", "TBVorwahl", "") & alleTelNr(i)
                If alleTelNr(i) = TelNr Then
                    formWählbox.listTel.List(iTelNr, 1) = alleNrTypen(i) & " *"
                Else
                    formWählbox.listTel.List(iTelNr, 1) = alleNrTypen(i)
                End If
                formWählbox.listTel.List(iTelNr, 2) = alleTelNr(i)
                iTelNr = iTelNr + 1
            End If
        Next
    End If
    ' Keine der Telefonnummern darf bereits ausgewählt werden
    formWählbox.listTel.ListIndex = -1
    ' Wähldialog anzeigen
    formWählbox.Show vbModeless
End Function

Damit Kann ich auch aus einem Kontakt mit dem entsprechendem StoreID die Wählbox aufrufen.

ergo => neben der KontaktID sollte der Funktion noch die StoreID übergeben werden
siehe http://www.exchangewise.com/Products/MXContact/Help/02_Developers_Guide/04_Client_Object_Use/02_E_H/GetItemFromID.htm

Gruss x-herbert

 

[x-herbert]

IP-Suche

@Kruemelino

getestet...


....hmmm: haut bei mir noch nicht hin
mein obiges Script gibt mir folgendes aus
192.168.0.1 / NVIDIA nForce MCP Networking Adapter - Paketplaner-Miniport
0.0.0.0 / LANCOM Secure Client Adapter - Paketplaner-Miniport
192.168.48.21 / Virtual STB-S/-C/-T Network Adapter - Paketplaner-Miniport
192.168.223.1 / VMware Virtual Ethernet Adapter for VMnet1
192.168.32.1 / VMware Virtual Ethernet Adapter for VMnet8

dabei ist die 192.168.0.1 meine Netzwerkkarte

Die FB hat 192.168.1.2 (Historische Gründe...)

Die beiden finden so zueinander, da in der Netzwerkkarte als Standardgateway 192.168.1.2 eingetragen ist (+ DNS = 192.168.1.2)

... wird es nicht einfacher sein, das Feld schreibbar zu machen bzw. als Auswahlliste, wenn mehrere Netzwerkadapter gefunden wurden?

inkl mit Standardgateway finden:

Function LocalIPAddress() As String
On Error Resume Next
'für API-Aufrufe
Dim cbRequired  As Long
Dim buff()      As Byte
Dim Adapter     As IP_ADAPTER_INFO
Dim AdapterStr  As IP_ADDR_STRING
'allgemeine Variablen
Dim ptr1        As Long
Dim sIPAddr     As String
Dim sGWAddr     As String
Dim sAllAddr    As String

Dim FB_ADD      As String
Dim pos         As Long

FB_ADD = GetSetting("FritzBox", "Optionen", "TBFBAdr", "192.168.178.1")
pos = InStrRev(FB_ADD, ".", , vbTextCompare)
FB_ADD = Left(FB_ADD, pos)
Call GetAdaptersInfo(ByVal 0&, cbRequired)
If cbRequired > 0 Then
    ReDim buff(0 To cbRequired - 1) As Byte
    If GetAdaptersInfo(buff(0), cbRequired) = 0 Then
        'Zeiger (Pointer) zu den gespeicherten Daten (buff) ermitteln
        ptr1 = VarPtr(buff(0))
        'ptr1 ist 0 wenn keine weiteren Adapter vorhanden sind
        Do While Not ptr1 = 0
            'aktuellen Zeiger auf Datenstruktur (Adapter) zuweisen
            CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
            With Adapter
                'IP-Adresse des Adapters auslesen
                sIPAddr = TrimNull(StrConv(.IpAddressList.ipaddress.ipAddr, vbUnicode))
                ' IP-Adresse des zugehörigen Gateways auslesen
                sGWAddr = TrimNull(StrConv(.GatewayList.ipaddress.ipAddr, vbUnicode))
                ' vergleiche Gateway-IP oder NW-IP mit FB-IP
                If Not InStr(1, sGWAddr, FB_ADD, vbTextCompare) = 0 Then
                  LocalIPAddress = sIPAddr
                Else
                  If Not InStr(1, sIPAddr, FB_ADD, vbTextCompare) = 0 Then LocalIPAddress = sIPAddr
                End If
                'sAllAddr = sAllAddr & sIPAddr & vbNewLine
                'Poiner auf nächsten Adapter setzen
                ptr1 = .dwNext
            End With
        Loop
    End If
End If
End Function

=> damit wird bei mir die richtige IP gefunden - ob man das so veralgemeinern kann...???

[PS: bin kein ausgesprochener VB/VBA-Programmierer => daher kann der Code auch recht "unelegant" aussehen]

Gruss x-herbert

 

[Kruemelino]

            With Adapter
                'IP-Adresse des adapters auslesen
                sIPAddr = TrimNull(StrConv(.IpAddressList.ipaddress.ipAddr, vbUnicode))
                ' IP-Adresse des zugehörigen Gateways auslesen
                sGWAddr = TrimNull(StrConv(.GatewayList.ipaddress.ipAddr, vbUnicode))
                If Not InStr(1, sGWAddr, FB_ADD, vbTextCompare) = 0 Or Not InStr(1, sIPAddr, FB_ADD, vbTextCompare) = 0 Then
                  LocalIPAddress2FritzBox = sIPAddr
                End If
                'und Name des Adapters durch das Ascii-Zeichen 1 getrennt, anfügen
                'If Not InStr(1, sIPAddr, FB_ADD, vbTextCompare) = 0 Then LocalIPAddress2FritzBox = sIPAddr
                'sAllAddr = sAllAddr & sIPAddr & vbNewLine
                'Poiner auf nächsten Adapter setzen
                ptr1 = .dwNext
            End With

Hab deinen code man "schöner" gemacht. Teste mal. ich fahr fix nach Dresden. bin gleich wieder da

 

[x-herbert]

... viel hübscher ;-)

appropo Dresden -> biste einer von unseren "Brüdern und Schwestern"?

[bin in Borna b. Lzg geb.]

Gruss x-herbert

 

[x-herbert]

Mapi

brauch mal Hilfe...

ich suche noch nach der Lösung, in allen Kontakten nach einer Telefonummer zu suchen

Folgendes Testscript:

Sub mytest()
    
    Dim outApp        As Outlook.Application
    Dim outNms        As Outlook.NameSpace
    Dim aktKontakt    As Object  ' aktuelles Element
    Dim iIndx, jIndx  As Integer
    Dim sAdLName      As String
     
    Set outApp = New Outlook.Application
    Set outNms = outApp.GetNamespace("MAPI")
 
    For iIndx = 1 To outNms.AddressLists.Count
      sAdLName = outNms.AddressLists.Item(iIndx)
        For jIndx = 1 To outNms.AddressLists.Item(iIndx).AddressEntries.Count
          Set aktKontakt = outNms.AddressLists.Item(iIndx).AddressEntries.Item(jIndx)
        Next
    Next
        
End Sub

leider ist bei der Überwachung von aktKontakt nur Name und eMail zu finden und keine Telefonnummern - ansonnsten läuft das ganze über alle Kontaktordner..

Gruss x-herbert

 

[Kruemelino]

Also nur mal als Hinweis:
Du durchsuchst das Adressbuch (AddressLists). Dadrinn kannst du Emails finden. Darin werden nur Kontakte aufgelistet, die eine Email haben. Der Nachteil an deinem Code ist aber ein Anderer: Man muss die Kontakte als Outlook-Adressbuch verwenden. Das kann man auch ausstellen. Dann werden aber die Kontakte nicht in dem Adressbuch geführt.
Wenn bei dir nicht alle Kontakte gefunden werden, liegt es sicher daran, dass du mehrer Kontakt-Ordner hast. Mein Code durchsucht nur den Standardordner und alle sich darin befindenden Unterordner. (Um dein Problem zu lösen könntest du auch aus vielen Kontakt-Ordnern einen machen (Mit Unterordnern)). Wenn du allerdings den Ehrgeiz hast, den Code zu ändern, ist das auch nicht schlecht. DU musst einen Weg finden alle Kontakt-Ordner zu durchsuchen.

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderContacts))

Das bringt dich zu dem Standardkontaktordner.

CreateObject("Outlook.Application").GetNamespace("MAPI").Folders.Count

Dürfte die Anzahl der Ordner angeben (Bin ich mir aber nicht sicher, bei mir liefert es 1, bei einem Ordner).

Ich helf dir gerne weiter.

 

[x-herbert]

suche alle Kontakte

DIRTY HACKING!!!

Thema ist immer noch "Suche alle Kontakte"

Vorweg. ich habe drei "Hauptordner" mit jeweils mehreren Kontakte-Ordnern

mein Testscript:

Sub mytest()
    
    Dim outApp        As Outlook.Application
    Dim outNms        As Outlook.NameSpace
    Dim aktKontakt    As Object  ' aktuelles Element
    Dim iIndx, jIndx, kIndx  As Integer
    Dim sAdLName      As String
    Dim sFdrMName     As String  ' Haupt-ordner-Name
    Dim alleTelNr     As Variant ' alle TelNr eines Kontakts
    Dim outFdr        As MAPIFolder
    Dim outCon        As Object

    
    Set outApp = New Outlook.Application
    Set outNms = outApp.GetNamespace("MAPI")
 
   
    For iIndx = 1 To outNms.Folders.Count
      sFdrMName = outNms.Folders.Item(iIndx).Name
      For jIndx = 1 To outNms.Folders.Item(iIndx).Folders.Count
        Set outFdr = outNms.Folders.Item(iIndx).Folders.Item(jIndx)
        If outFdr.DefaultItemType = olContactItem Then
          For kIndx = 1 To outNms.Folders.Item(iIndx).Folders.Item(jIndx).Items.Count
            Set outCon = outNms.Folders.Item(iIndx).Folders.Item(jIndx).Items.Item(kIndx)
            With outCon
              ' nur Kontakte werden durchsucht
              If .Class = olContact Then
                  alleTelNr = Array(.AssistantTelephoneNumber, .BusinessTelephoneNumber, _
                      .Business2TelephoneNumber, .CallbackTelephoneNumber, .CarTelephoneNumber, _
                          .CompanyMainTelephoneNumber, .HomeTelephoneNumber, .Home2TelephoneNumber, _
                                  .ISDNNumber, .MobileTelephoneNumber, .OtherTelephoneNumber, _
                                      .PagerNumber, .PrimaryTelephoneNumber, .RadioTelephoneNumber)
              End If
            End With
          Next
        End If
      Next
    Next
    
    Set outFdr = outNms.GetDefaultFolder(olFolderContacts)
    For iIndx = 1 To outFdr.Items.Count
      Set outCon = outNms.GetDefaultFolder(olFolderContacts).Items(iIndx)
      With outCon
        ' nur Kontakte werden durchsucht
        If .Class = olContact Then
            alleTelNr = Array(.AssistantTelephoneNumber, .BusinessTelephoneNumber, _
                .Business2TelephoneNumber, .CallbackTelephoneNumber, .CarTelephoneNumber, _
                    .CompanyMainTelephoneNumber, .HomeTelephoneNumber, .Home2TelephoneNumber, _
                            .ISDNNumber, .MobileTelephoneNumber, .OtherTelephoneNumber, _
                                .PagerNumber, .PrimaryTelephoneNumber, .RadioTelephoneNumber)
        End If
      End With
    Next
        
End Sub

Im "ersten" Teil finde ich alle meine Kontakte mit entsprechenden Telefonnummern - leider keine Unterordner...
Wenn man das "outNms" ausgeben lässt, sind alle Elemente gut zu "sehen"

Ich habe mal den Code aus "FindeAbsender" übernommen um zu testen, ob hier auch die Unterordner gefunden werden (habe in dem Default-Kontakte ein Unterodner angelegt) - die werden aber bei der "zweiten" Schleife nicht aufgelistet???

[dass die Schleifen auch mit "each" usw. gehen is schon klaro... hier gehts ums Prinzip!]

Würde gern mal die Meinung der Fachmänner hören/lesen...

Gruss x-herbert