Új hozzászólás Aktív témák

• #1219 Fire/SOUL/CD félisten lrigo #1218

  Új Válasz 2008-12-17 17:38:22 #1219

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fire/SOUL/CD

  félisten

  válasz lrigo #1218 üzenetére

  Hali!

  Akkor próbáljuk meg!(Nálam működik x64 Vista, 2007 Outlook)

  Fontos: A makró csak MS Office Outlook 2003, 2007 verziónál használható!!!
  Továbbá, csak akkor működik helyesen, ha az email cím ELSŐDLEGES!!!
  (tehát ha valakinek több email címe van, akkor csak az elsőt nézi, a többit nem. Ha nem ebben van a kicserélendő rész, akkor ne használd)

  1. indítsd el az Outlook-ot

  2. ALT+F11 - ekkor megjelenik a VBA editor

  3. INSERT menu/Module (NEM Class Module!!!)
  Most megjelenik egy üres "ablak" "VbaProject.OTM - Module1 (Code)" fejléccel, na ebbe kell bemásolni az általam küldött makró-kódot. (persze a CTRL+C ill. CTRL+V segítségével)

  Option Explicit
  
  Public Sub TestAddressBookFindReplace()
  AddressBookFindReplace "Névjegyalbum", "@ubul", "@gmail."
  End Sub
  
  Public Sub AddressBookFindReplace(addressBookName As String, findText As String, replaceText As String, Optional compareMethod As VbCompareMethod = vbBinaryCompare)
  Const lngStart_c As String = "1"
  Const lngNotFound As Long = 0
  Const lngCount_c As Long = -1
  Dim ns As Outlook.NameSpace
  Dim al As Outlook.AddressList
  Dim ae As Outlook.AddressEntry
  Dim strAddr As String
  Set ns = Outlook.Session
  Set al = ns.AddressLists(addressBookName)
  For Each ae In al.AddressEntries
  On Error GoTo err
  strAddr = vbNullString
  strAddr = ae.Address
  If strAddr <> "" Then
  If InStrB(lngStart_c, strAddr, findText, compareMethod) <> lngNotFound Then
  ae.Address = VBA.Replace(strAddr, findText, replaceText, lngStart_c, lngCount_c, compareMethod)
  ae.Update True, False
  End If
  End If
  Next
  Exit Sub
  err: err.Clear
  Resume Next
  End Sub

  4. a makró elején van ez a sor
  AddressBookFindReplace "Névjegyalbum", "@ubul.", "@gmail."
  Jelen esetben a "@ubul."-ot cseréli "@gmail."-ra, tehát módosítsd a Neked megfelelőre.
  Ha magyar az Outlook, akkor "Névjegyalbum", ha Angol akkor meg "Contacts" az első paraméter

  5. DEBUG menu/Compile Project1

  6. FILE menu/Save project

  7. A futtatáshoz F5 vagy az eszköztáron a zöld kis nyíl

  Fontos!
  Elöször feltétlenül készíts másolatot a leveleidről, azaz archiváld, vagy exportáld PST fájlba!!!
  Mint említettem x64 Vista + MS Office Outlook 2007 alatt próbáltam, itt működött, de más verziónál nem tudom garantálom a helyes működést!

  Ha minden rendben megcsináltál, és már nincs szükséged a makróra, akkor meg töröld.
  1. Outlook indít
  2. ALT+F11
  3. jobbegérgomb a Module1-n, REMOVE Module1
  
  4. megjelenik egy kérdés, hogy mielött törlöd, exportálja-e a makrót: NEM
  5. VBA editor becsuk
  6. Outlook becsuk
  7. megint kérdés, mentse-e a Project változásait: IGEN

  Na, asszem ennyi, remélem sikerül minden!
  Azért írj, hogy mi lett az eredmény.

  Fire.

  [ Szerkesztve ]

  Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)

Új hozzászólás Aktív témák