Hallo liebe Community,

ich nutze das Script von Niel Malek (https://www.youtube.com/watch?v=1x-Vk4Qmpz0), um Checkboxen und Freitext aus mehreren Worddokumenten (.docm oder docx) geordnet in eine Exceldatenbank (.xlsm) zu übertragen. Die Checkboxen befinden sich normal platziert und in Tabellen.

Leider hängt sich das Skript immer auf und es kommen folgende Fehlermeldungen: "Objekt unterstützt diese Eigenschaft oder Methode nicht" und dannach manchmal "Microsoft Office Excel wartet auf die Beendigung einer OLE-Aktion in einer anderen Anwendung".

Meine These ist, es hat irgendwetwas mit AddIns in Word oder mit Admin-Rechten zu tun. Kann mir jmd einen Lösungsansatz verraten?

Vielen Dank.

Hier das Skript:

'https://www.youtube.com/watch?v=1x-Vk4Qmpz0
Sub GetFormData()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim FmFld As Word.FormField
Dim CCtrl As Word.ContentControl
Dim strFolder As String
Dim strFile As String
Dim WKSht As Worksheet, i As Long, j As Long
strFolder = Getfolder
If strFolder = "" Then Exit Sub
Set WKSht = ActiveSheet
i = WKSht.Cells(WKSht.Rows.Count, 1).End(xlUp).Row

strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
    i = i + 1
    Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentfiles:=False, Visible:=False)'hier hängt sich das Skript auf
        With wdDoc
            j = 0
                For Each FmField In .FormFldFields
                'For Each FmField In .ContentControls
                j = j + 1
                WKSht.Cells(i, j) = FmFld.Result
                'WKSht.Cells(i, j) = CCtrl.Range.Text
                Next
        End With
        wdDoc.Close SaveChanges:=False
        strFile = Dir()
Wend
wdApp.Quit
Set wd.Doc = Nothing: Set wdApp = Nothing: Set WKSht = Nothing
Application.ScreenUpdating = True
End Sub

Function Getfolder() As String
    Dim oFolder As Object
    Getfolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder ", 0) '" <-habe ich ausgeklammert, da ich die Gänsefüße unnötig fand
    If (Not oFolder Is Nothing) Then Getfolder = oFolder.Items.Item.Path
    Set oFolder = Nothing

End Function