Option
Explicit
Private
Type typPDF
Suchwert
As
String
FullPath
As
String
Found
As
Boolean
End
Type
Const
A
As
String
=
"Affaire nouvelle"
Const
B
As
String
=
"Avenant"
Const
C
As
String
=
"Annulation"
Sub
main()
Dim
varTypPDF()
As
typPDF
Dim
v()
As
Variant
Dim
i
As
Long
v = Array(A, B, C)
ReDim
varTypPDF(UBound(v))
For
i = LBound(v)
To
UBound(v)
Step
1
varTypPDF(i).Suchwert = v(i)
varTypPDF(i).Found = FindAndFound(ActiveDocument, v(i))
Next
i
For
i = LBound(varTypPDF)
To
UBound(varTypPDF)
Step
1
MsgBox
"Suchwert: "
& varTypPDF(i).Suchwert _
& vbNewLine & _
"Dateipfad: "
& varTypPDF(i).FullPath _
& vbNewLine & _
"gefunden:"
& varTypPDF(i).Found
Next
i
End
Sub
Function
FindAndFound(
ByRef
wdDoc
As
Word.Document,
ByVal
sSuchString
As
String
)
As
Boolean
Dim
rng
As
Word.Range
Set
rng = wdDoc.Content
With
rng
Call
.Find.Execute(sSuchString)
FindAndFound = .Find.Found
End
With
End
Function
Function
openPdfAsDoc(
ByVal
sDateiPfad
As
String
)
As
Word.Document
Set
openPdfAsDoc = Application.Documents.Open(FileName:=sDateiPfad, _
ConfirmConversions:=
False
, _
ReadOnly
:=
False
, _
AddToRecentFiles:=
False
, _
PasswordDocument:=
""
, _
PasswordTemplate:=
""
, _
Revert:=
False
, _
WritePasswordDocument:=
""
, _
WritePasswordTemplate:=
""
, _
Format:=wdOpenFormatAuto, _
XMLTransform:=
""
, _
NoEncodingDialog:=
True
)
End
Function