Option
Explicit
Option
Private
Module
Private
lblnTMP
As
Boolean
Public
Sub
Fill_Boxes(
ByVal
pvstrText
As
String
)
Const
FILE_PATH
As
String
= "C:\Users\MyUser\Documents\Excel\"
Const
FILE_NAME
As
String
=
"MyExcelFile.xlsx"
Const
xlValues
As
Long
= -4163
Const
xlWhole
As
Long
= 1
Dim
objApp
As
Object
Dim
objWorkbook
As
Object
Dim
objCell
As
Object
On
Error
GoTo
Sub_Exit
Set
objApp = OffApp(
"Excel"
)
If
Not
objApp
Is
Nothing
Then
For
Each
objWorkbook
In
objApp.Workbooks
If
objWorkbook.Name = FILE_NAME
Then
Exit
For
Next
If
objWorkbook
Is
Nothing
Then
_
Set
objWorkbook = objApp.Workbooks.Open(FileName:=FILE_PATH & FILE_NAME)
Set
objCell = objWorkbook.Worksheets(1).UsedRange.Find(What:=Trim$(pvstrText), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=
False
)
If
Not
objCell
Is
Nothing
Then
With
ActiveDocument
.SelectContentControlsByTitle(
"TextBox2"
)(1).Range.Text = objCell.Offset(0, 1).Value
.SelectContentControlsByTitle(
"TextBox3"
)(1).Range.Text = objCell.Offset(0, 2).Value
End
With
Else
Call
MsgBox(Prompt:=
"Searched Data couldn't be found!"
, Buttons:=vbExclamation, Title:=
"Error"
)
End
If
Else
Call
MsgBox(Prompt:=
"Application not installed!"
, Buttons:=vbExclamation, Title:=
"Error"
)
End
If
Sub_Exit:
If
Not
objApp
Is
Nothing
Then
If
lblnTMP
Then
Call
objApp.Quit
lblnTMP =
False
End
If
End
If
Set
objCell =
Nothing
Set
objWorkbook =
Nothing
Set
objApp =
Nothing
If
Err.Number <> 0
Then
Call
MsgBox(Prompt:=
"Fehler: "
& _
Err.Number &
" "
& Err.Description, _
Buttons:=vbExclamation, Title:=
"Error"
)
End
Sub
Private
Function
OffApp(
ByVal
pvstrApp
As
String
, _
Optional
ByVal
opvblnVisible
As
Boolean
=
True
)
As
Object
Dim
objApp
As
Object
On
Error
Resume
Next
Set
objApp = GetObject(
Class
:=pvstrApp &
".Application"
)
If
Err.Number = 429
Then
Call
Err.Clear
Set
objApp = CreateObject(
Class
:=pvstrApp &
".Application"
)
lblnTMP =
True
If
opvblnVisible
Then
On
Error
Resume
Next
objApp.Visible =
True
Call
Err.Clear
End
If
End
If
On
Error
GoTo
0
Set
OffApp = objApp
Set
objApp =
Nothing
End
Function