title image


Smiley Re: E-Mail-Adressen via Makro suchen lassen
Hallo Marco,



versuche es mit nachfolgendem Makro. Ich habe es bei mir ausprobiert, es lief ohne Fehler. Achte darauf, dass nur ein leeres Dokument geöffnet ist, wenn Du das Makro startest. Sonst findet Word die Fenster nicht mehr.

'Attribute VB_Name = "Modul1"

Sub TestFindHlink()

Dim i As Long

Dim oDok As Document

Dim oLink As Hyperlink



With Application.FileSearch

.NewSearch

' Verzeichnis anpassen

.LookIn = "D:\"

.SearchSubFolders = False

.FileName = "*.htm*"



If .Execute() > 0 Then

' alle Dateien im Ordner

For i = 1 To .FoundFiles.Count

' äussere Schleife Anfang

Set oDok = Documents.Open(FileName:=.FoundFiles(i))

' alle Hyperlinks im Dokument, die @ enthalten

For Each oLink In oDok.Hyperlinks

' innere Schleife Anfang

With Selection.Find

.Text = "@"

.Wrap = wdFindStop

oLink.Range.Select

strText = Selection.Text

Selection.Copy



' Fensterwechsel

Windows(1).Activate



' Einfügen

Selection.EndKey Unit:=wdStory

Selection.PasteSpecial Link:=False, DataType:=wdPasteRTF, Placement:= _

wdInLine, DisplayAsIcon:=False

Selection.TypeParagraph



' Fensterwechsel

Windows(2).Activate



End With

' MsgBox strText

' innere Schleife Ende

Next oLink



' Htm[l]-Dokument schliessen

oDok.Close SaveChanges:=wdDoNotSaveChanges

Next i

' äussere Schleife Ende

Else

MsgBox "Keine Dokumte gefunden!"

End If

End With

End Sub

Hubert



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: