Option
Explicit
Sub
Word2Excel()
Dim
xlApp
As
Excel.Application
Dim
wkb
As
Excel.Workbook
Dim
wks
As
Excel.Worksheet
Dim
rng
As
Excel.Range
On
Error
GoTo
FinishErr
Set
xlApp = GetObject(class:=
"Excel.Application"
)
Set
wkb = xlApp.Workbooks.Open(
"Pfad_zur_Datei"
)
Set
wks = wkb.Worksheets(
"Tabelle1"
)
Set
rng = wks.Range(
"A1"
)
FinishErr:
Select
Case
Err.Number
Case
429:
Set
xlApp = CreateObject(class:=
"Excel.application"
)
Resume
Next
Case
Else
Debug.Print Err.Number & vbNewLine & Err.Description
End
Select
Set
rng =
Nothing
:
Set
wks =
Nothing
:
Set
wkb =
Nothing
:
Set
xlApp =
Nothing
End
Sub