Extract email addresses from Eudora's Address Book

[Gösta H. Lovgren-2]

Why not in Source Code code Forum> ?

Where would you look for Source Code to extract addresses from Eudora address book?

Me, I'd search subject Eudora, forum source code, all dates.

MCM

As always, a good point. I'll repost it there.

===============================
"Money doesn't make you happy.
I now have $50 million but I was just as happy
when I had $48 million."
Arnold Schwarzenegger
===============================

[Michael Mattias]

Why not in Source Code code Forum> ?

Where would you look for Source Code to extract addresses from Eudora address book?

Me, I'd search subject Eudora, forum source code, all dates.

MCM

[Gösta H. Lovgren-2]

I just had occasion to extract the addys from Eudora's address book.

Here's the code for whatevervalue any may find:

'

 ' Extracts email addresses from Eudora's Address book  
 ' To run you must:
 '  1) Change the folder in 'Sub Extract_Email_addresses_from_Eudora  
 '     to where "NNdbase.txt" is located on your computer  
 '  2) Change the folder for "c:\Temp\Unique_Email_Addresses.txt" 
 '     from "C:\Temp\" to whatever you use 
 ' 
 ' What I did was run the program then look at the Unique file 
 '  in a text editor, note the errors then make changes to the 
 '  Replace statements and the "Skips" list as appropriate for the list.
 '  
 '  
 '  
 '  It will probably take several runs before the Unique file is okay.
 '                          
 ' For the record I had 4,538 useable addresses out of 9,706 total in
 '  the address book. 
 '
 ' [EMAIL="[email protected]"][email protected][/EMAIL]
 ' [URL]http://www.AnAmericanCares.com[/URL] 
 ' [URL]http://www.SwedesDock.com[/URL]
 
 
 
 
 
 #Compile Exe
 #Dim All
 '
 #Include "WIN32API.INC"
 '
 %Sample_TB = 1000
 '                                        
 'email addys
 Type Addy              
   Sort_Field As String * 50
   Nam As String * 50
   Domain As String * 50
   Flag As Long
   Dup_flag As Long
 End Type   
   Global Addys() As Addy
   Global addys1() As Addy
 
 '                                 
 Macro Common_Locals
   'note - not all these used in Sample
   Local Ans&, a$, a1$, Array_End&
   Local Box_Height&, Btn_Width&, Btn_Height&
   Local Caption$, col&, Code$, ctr&, ctr1&, ctr2&, ctr3&
   Local Domain$
   Local email$, ep&, er$ 'used for error msgs
   Local Fil$, Fil1$, Flag&, flen&, fnum&, fnum1&, fnum2&
     Local Files$()
   Local hght&
   Local i&, i1&, i2&, i3&, id&
   Local l$, l1&, Lng&, lng1&, ln$()
   Local m$, m1$      
   Local n&, num&, num1&
   Local r&, Row&, Row1&
   Local shrt&, sp&, Spcr&
   Local Tb_Height&
   Local Wdth&      
   Local x&, x1&
 
 
 
   Dim Files$(0)
   Box_Height = 12 
   Tb_Height  = 12    
 
   %Top = %MB_TASKMODAL 'I can never remember %MB_TASKMODAL for MB's  
 
 'Common RGB Colors from Win32Api.Inc 
   %Black   = &H000000???
   %Blue    = &HFF0000???
   %Green   = &H00FF00???
   %Cyan    = &HFFFF00???
   %Red     = &H0000FF???
   %Magenta = &HFF00FF???
   %Yellow  = &H00FFFF???
   %White   = &HFFFFFF???
   %Gray    = &H808080???
   %LtGray  = &HC0C0C0???
   %Purple = &hFF5588
   %BabyBlue = 167 + (241 * 256) + (252 * 256 * 256) 
   %Pink     = 255 + (132 * 256) + (132 * 256 * 256)
   %Cream    = 252 + (241 * 256) + (167 * 256 * 256) 
   %BiliousYG = %Cream + 1000 ' Bilious Yellow Green 
   %MintGreen = &HD0FFD0
 
 End Macro
 '                               
 '
 Macro Err_Msg                       
  'er$ set by programmer
  If Err Then
    ? Using$("# ", Err) & Error$(Err) &  $CrLf &_
      er$,, FuncName$ 
     Reset er$ 'for next time
  End If  
 End Macro 
 '                   
 
 '
 Macro mb_ans = Ans = MsgBox(m$, %MB_TASKMODAL Or %MB_YESNO, " in " & FuncName$ & m1$ )
 ' example usage
 '  m$ = "Do you REALLY want to erase everything?"
 '  mb_ans
 '  If ans = %IdYes Then             
 '    '
 '  End If
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 '
 Macro mb = ? m$, %Top, FuncName$
 '
 
 '
 Macro pf = Print #Fnum, 
 '
 Macro m_Sort_by_Domain
    For x = LBound(Addys()) To UBound(addys())
       addys(x).Sort_Field = addys(x).Domain
    Next x
    Array Sort addys()
 End Macro
 '
 Macro m_Sort_by_Name
    For x = LBound(Addys()) To UBound(addys())
       addys(x).Sort_Field = addys(x).Nam
    Next x
    Array Sort addys()
 End Macro
 '
 Macro m_Iterate_Loop = If InStr(LCase$(m$), LCase$(l$)) Then Iterate Loop
 '
 
 
 '                               
 Sub Extract_Email_addresses_from_Eudora
    Common_Locals
 
     'Change to appropriate folder
   Fil$ = "C:\Program Files\Eudora\NNdbase.txt" 'addresses
   Fnum = FreeFile
   Open fil$ For Binary As #fnum
    flen = Lof(fnum)
   fil$ = String$(flen, 32) 
   Get fnum, 1, fil$
   Close
 
    'clean up file
    Replace "<" With " " In fil$
    Replace ">" With " " In fil$
    Replace "@ " With "@" In fil$
    Replace ".com." With ".com " In fil$
    Replace ".ne " With ".net " In fil$
    Replace ".Ne " With ".Net " In fil$
    Replace "[email protected]" With "[EMAIL="[email protected]"][email protected][/EMAIL] " In fil$
    Replace "[email protected]," With "[EMAIL="[email protected]"][email protected][/EMAIL]," In fil$
    Replace "[email protected]" With "[EMAIL="[email protected]"][email protected][/EMAIL]" In fil$
    Replace "[email protected]" With "[EMAIL="[email protected]"][email protected][/EMAIL] " In fil$
    Replace "[email protected]" With "[EMAIL="[email protected]"][email protected][/EMAIL]" In fil$
    Replace "[EMAIL="[email protected]"][email protected][/EMAIL]." With "[EMAIL="[email protected]"][email protected][/EMAIL] " In fil$
    Replace "[EMAIL="[email protected]"][email protected][/EMAIL]." With "[EMAIL="[email protected]"][email protected][/EMAIL] " In fil$
 '   Replace "@ " With "@" In fil$
 '   Replace "@ " With "@" In fil$
 '   Replace "@ " With "@" In fil$
 '   Replace "@ " With "@" In fil$
 '   Replace "@ " With "@" In fil$
 '   Replace "@ " With "@" In fil$
    Replace "," With " " In fil$
    Replace  $CrLf With "  " In fil$
 
    Fil$ = " " & fil$ & " " 'pad it out to find 1st & last addys
    ctr1 = ParseCount(fil$, "@")
 
 
    i = 1
    shrt = 1000
   While i
    i = InStr(Fil$, "@") 'find addy
     If i Then       
       i2 = InStr(i, fil$, " ") 'find end of addy
        m$ = Left$(Fil$, i2 - 1) 'isolate it
 
       Fil$ = Trim$(Mid$(Fil$, i2))' strip from file
 
       i3 = InStr(-1, m$, " ")'find beginning of addy
       m$ = Mid$(m$, i3 + 1 )'pick it out
 
         'skips 
       l$ = "Senate.Gov": m_Iterate_Loop 'no senators this run
 
       l$ = "reply": m_Iterate_Loop 
       l$ = "confirm": m_Iterate_Loop 
       l$ = "ladies.only": m_Iterate_Loop 
       l$ = "[email protected]": m_Iterate_Loop 
       l$ = "Dxoburch": m_Iterate_Loop 
       l$ = "Fzbigarrett": m_Iterate_Loop 
       l$ = "Announce": m_Iterate_Loop 
       l$ = ".Info": m_Iterate_Loop 
       l$ = "[EMAIL="[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       l$ = "[EMAIL="[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       l$ = "Notification": m_Iterate_Loop 
       l$ = "Oprah.Com": m_Iterate_Loop 
       l$ = "Pondersbible": m_Iterate_Loop 
       l$ = "Powerbasicprg": m_Iterate_Loop 
       l$ = "Puritans_Pride": m_Iterate_Loop 
       l$ = "[EMAIL="[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       l$ = "[EMAIL="[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       l$ = "[EMAIL="Spam_Account[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       l$ = "[EMAIL="[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       l$ = "[EMAIL="[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       l$ = "[EMAIL="[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       l$ = "[EMAIL="[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       l$ = "[EMAIL="[email protected]"][email protected][/EMAIL]": m_Iterate_Loop 
       'l$ = "Fzbigarrett": m_Iterate_Loop 
       'l$ = "Fzbigarrett": m_Iterate_Loop 
       'l$ = "Fzbigarrett": m_Iterate_Loop 
       'l$ = "Fzbigarrett": m_Iterate_Loop 
       'l$ = "Fzbigarrett": m_Iterate_Loop 
       'l$ = "Fzbigarrett": m_Iterate_Loop 
       'l$ = "Fzbigarrett": m_Iterate_Loop 
 
 
 
        l1 = Len(m$) 'find longest addy for Type Setting
        If l1 > lng Then 
           lng = L1
        End If   
 
        If l1 < shrt Then 
           shrt  = L1
        End If   
 
        If shrt < 10 Then 'too short I think for good addy
           shrt = 1000  
           Iterate Loop 'start looking again
        End If  
 
       Incr ctr 
       ReDim Preserve Addys(1 To ctr)
       Addys(UBound(Addys())).Nam = MCase$(m$)
       i =InStr(m$, "@") 'find domain
        If i Then     
          m$ = LCase$(Mid$(m$, i + 1))
          If Trim$(m$) = "aol" Then m$ = "Aol.com" 'fix truncated addresses
          Addys(UBound(Addys())).Domain = MCase$(m$)
        End If
     End If 'end of: i = InStr(Fil$, "@") 'find addy    
    Wend                    
 
    m_Sort_by_Name
 '   m_Sort_by_Domain   'used to find corrupted domains  
 
  'find dups 
    Array_End = UBound(addys())
    For x = LBound(Addys()) To UBound(addys())
       If x < UBound(Addys()) Then
          If addys(x).Nam = addys(x + 1).Nam Then
             addys(x).Dup_Flag = 1
          End If 
       End If   
     Next x
 
 
    'print uniques
    Open "c:\Temp\Unique_Email_Addresses.txt" For Output As #fnum    
 
    Reset ctr 
    For x = LBound(Addys()) To UBound(addys())
       ctr = ctr + addys(x).Dup_Flag
        If addys(x).Dup_Flag = 0 Then
          pf addys(x).Nam
          If Left$(addys(x).Domain, 3) ="Aol" Then Incr ctr3 'count aol's 
        End If  
    Next x
 
   m$ = $CrLf & Using$("#, addys total  #, dups  #, good", ctr1, ctr, ctr1-ctr) & $CrLf  & _
        Using$("  # Aols every # emails", _
                ctr3, ctr \ ctr3)
   mb               
   pf  $CrLf  &  $CrLf  & m$
   Close
 
 '  Call Create_Email_List(Ctr, ctr3)
 '  
 End Sub
 '
 Sub Testing
 End Sub
 CallBack Function CB_Main_Dialog As Long
 End Function
 '
 Function PBMain
   Local hDlg As Dword
   Dialog New 0, "Sample Example",,, 100, 200,, To hDlg
    Call Extract_Email_addresses_from_Eudora
 '  Dialog Show Modal hDlg, Call CB_Main_Dialog
 
 End Function 
 '