Iskanje in označevanje besedila

[GoldZ]

Pozdravljneni!

Pišem makro, ki naj poišče vse e-maile v dokumentu in jih potem skopira na konec dokumenta. Sem še v fazi iskanja in označevanja le-teh. In tu so nastopile težave!

Prilagam kodo in na povezavi datoteko, kjer sem jo preizkušal. Mogoče jo preiskusite še vi in opazili boste, kaj ne deluje. Meni pa ni jasno. kaj?

Koda: Izberi vse

Function je_odstavek()
Selection.Find.Text = "^p"
Selection.Find.Execute

If Selection.Find.Found Then
    je_odstavek = True
Else
    je_odstavek = False
End If


End Function
Function je_konec_dokumenta()
'Funkcija vrne vrednost True, če se kurzor nahaja na
'koncu dokumenta.
  If Selection.Type = wdSelectionIP And Selection.End = ActiveDocument.Content.End - 1 Then
    je_konec_dokumenta = True
  Else
    je_konec_dokumenta = False
  End If
End Function
Sub Poisci_mail_final()
  Selection.HomeKey Unit:=wdStory 'Skok na začetek besedila
  While Not (je_konec_dokumenta())   'Zanko ponavljamo, dokler ne pridemo do konca besedila
    
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend 'Izberemo besedo
    
    niz$ = Trim(Selection.Text) ' Izbiro postavimo v spremenljikov niz$. S funkcijo Trim odrežemo presledke na začetku in koncu
    If niz$ = "@" Then
    
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
   
     While Not (Selection.Text = "<" Or Selection.Text = " ")
        
     Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdMove
     
       Wend
       Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        MsgBox "konec"
      '  MsgBox Selection.Text
     While Not (je_odstavek = True _
     Or Right(Selection.Text, 1) = " " _
     Or Right(Selection.Text, 1) = ">" _
     Or Right(Selection.Text, 1) = "!" _
     Or Right(Selection.Text, 1) = "?" _
     Or Right(Selection.Text, 1) = ";" _
     Or Right(Selection.Text, 1) = ",")
      
     Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend 'označimo besedo za @-no
    ' MsgBox Selection.Text
            Wend
            niz1$ = Selection.Text
    MsgBox niz1$
        Else
      Selection.MoveRight Unit:=wdWord, Count:=1 'odznačimo besedilo
    End If
  Wend

End Sub

Kontrolni MsgBox-i bi naj bili v pomoč.

Še dokument: primer.doc

[admin]

Pozdravljeni,

Malce sem gledal vašo funkcijo, potem pa sem vam raje napisal mojo (je hitreje ). V njej se lahko marsičesa naučite, predvsem pa sem se problema lotil drugače kot vi.

Jaz najprej celoten tekst dokumenta preberem v neko spremenljivko in potem iščem po njej (je neprimerno hitreje, kot pomikanje po Word dokumentu).

Ideja je preprosta. Najprej preberem celoten tekst v spremenljivko (tu lahko vidite kako najdete začetek in konec dokumenta!) in nato po tekstu iščem znake @. Ko znak @ najdem se pomikam levo dokler sem na znakih, ki se lahko pojavijo v e-naslovu. Nato se od znaka @ pomikam desno po znakih, ki se lahko pojavijo v e-naslovu. in E-naslov je vse med levo in desno mejo.

POZOR: Kateri znaki se lahko pojavijo v e-naslovu nisem točno preverjal. Če se razen črk, številk pike in pomišljaja lahko pojavi še kateri drug, samo popravite funkcijo AliZnakLahkoVNaslovu.

Koda: Izberi vse

' www.matjazev.net
' 27.10.2005

Option Explicit

Function AliZnakLahkoVNaslovu(znak) As Boolean
    AliZnakLahkoVNaslovu = ((znak >= "a") And (znak <= "z")) Or _
                           ((znak >= "A") And (znak <= "Z")) Or _
                           ((znak >= "0") And (znak <= "9")) Or _
                           (znak = ".") Or _
                           (znak = "-")
End Function

Sub mtest()
    Dim VsebinaDokumenta
    VsebinaDokumenta = ActiveDocument.Range(Start:=ActiveDocument.Bookmarks("\StartOfDoc").Range.Start, _
                                      End:=ActiveDocument.Bookmarks("\EndOfDoc").Range.End).Text
    
    Dim Start, nasel
    ' iščemo od začetka
    Start = 1
    nasel = InStr(Start, VsebinaDokumenta, "@")
    While (nasel) And (nasel > 0)
        ' našel sem @, pomikam se levo, dokler .e naletim na znak, ki ga ne sme biti
        Dim levo, desno, znak
        levo = nasel - 1
        znak = Mid(VsebinaDokumenta, levo, 1)
        While AliZnakLahkoVNaslovu(znak)
            levo = levo - 1
            znak = Mid(VsebinaDokumenta, levo, 1)
        Wend
        
        desno = nasel + 1
        znak = Mid(VsebinaDokumenta, desno, 1)
        While AliZnakLahkoVNaslovu(znak)
            desno = desno + 1
            znak = Mid(VsebinaDokumenta, desno, 1)
        Wend
        
        MsgBox Mid(VsebinaDokumenta, levo + 1, desno - levo - 1)
    
        nasel = InStr(nasel + 1, VsebinaDokumenta, "@")
    Wend
End Sub

PS: Osnovni problem vaše funkcije je v presledku. Ko najdete da je začetek e-naslova presledek vam program takoj pade iz While zanke, ker se ne premaknete desno. Pred while zanko se je potrebno (če ste našli presledek) 2x pomakniti desno.... + še nekaj problemov.

[GoldZ]

Najprej prisrčna hvala za vaš trud!

Res je, precej sem se naučil s tega makroja (mojega in vašega), predvsem pa, če rešiš en problem in se ti pojavi kopica drugih - začni znova .

Makro sem gradil postopoma in sedaj spoznavam, da sem sem si že na začetku zakompliciral zadevo (kot že nekolikokrat prej). Na preiskovanje besedila z dovoljenimi znaki (ne obratno) pa bi se res lahko spomnil. Ko sem naletel na problem presledka pred, pa mi je prekipelo... nadaljevanje zgodbe veste...

No, sedaj ga še dopolnim, da skopiram naslove na novo stran na koncu dokumenta in končano!

Še enkrat hvala!

P.S. V mailu se lahko nahaja še _ (podčrtaj)