BuiltinDocumentProperties - Word!

Über eine UserForm in Excel können die "BuiltinDocumentProperties" aus einer Worddatei gelesen bzw. geschrieben werden. In der ZIP-Datei im Download ist eine Testworddatei enthalten.

BuiltinDocumentProperties... [ZIP, 60 KB]

Code gehört in den Codebereich der UserForm:

Option Explicit
Dim objWDD As Object
Dim objWD As Object
Private Sub UserForm_Activate()
    TextBox1.Text = _
        "OptionButton ""Schreiben..."" oder ""Lesen..."". " & _
        vbCrLf & "Dann Worddatei über Button rechts auswählen..."
    OptionButton1.Value = True
    CommandButton3.Enabled = False
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then MsgBox "ESC-Button nutzen!": Cancel = True
End Sub
Private Sub CommandButton2_Click()
    Unload Me
End Sub
Private Sub CommandButton3_Click()
    Call Los
End Sub
Private Sub CommandButton1_Click()
    Dim varFile As Variant
    varFile = Application.GetOpenFilename _
        (FileFilter:="Word (*.doc*), *.doc*")
    If VarType(varFile) <> vbBoolean Then
        TextBox1.Text = varFile
        CommandButton3.Enabled = True
    Else
        TextBox1.Text = "Keine Datei ausgewählt..."
    End If
End Sub
Private Sub Los()
    On Error Resume Next
    Set objWD = GetObject(, "Word.Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objWD = CreateObject("Word.Application")
            If Err.Number > 0 Then
                MsgBox Err.Number & " " & Err.Description
                Set objWD = Nothing
                Exit Sub
            End If
        Case 0
        Case Else
            MsgBox Err.Number & " " & Err.Description
            Set objWD = Nothing
            Exit Sub
    End Select
    On Error GoTo 0
    On Error GoTo Fin
    If OptionButton1.Value = True Then
        Call Read_Word
    Else
        Call Write_Word
    End If
Fin:
    objWD.Quit
    Set objWDD = Nothing
    Set objWD = Nothing
    If Err.Number <> 0 Then MsgBox Err.Number & " " & Err.Description
End Sub
Private Sub Read_Word()
    objWD.Documents.Open (TextBox1.Text)
    Set objWDD = objWD.Documents(1)
    With objWDD
        TextBox2.Text = .BuiltinDocumentProperties("Title").Value
        TextBox3.Text = .BuiltinDocumentProperties("Author").Value
        TextBox4.Text = .BuiltinDocumentProperties("Company").Value
        TextBox5.Text = .BuiltinDocumentProperties("Manager").Value
        TextBox6.Text = .BuiltinDocumentProperties("Subject").Value
        TextBox7.Text = .BuiltinDocumentProperties("Category").Value
        TextBox8.Text = .BuiltinDocumentProperties("Hyperlink base").Value
        TextBox9.Text = .BuiltinDocumentProperties("Comments").Value
        TextBox10.Text = .BuiltinDocumentProperties("Keywords").Value
    End With
    objWD.ActiveDocument.Close False
End Sub
Private Sub Write_Word()
    objWD.Documents.Open (TextBox1.Text)
    Set objWDD = objWD.Documents(1)
    With objWDD
        .BuiltinDocumentProperties("Title").Value = TextBox2.Text
        .BuiltinDocumentProperties("Author").Value = TextBox3.Text
        .BuiltinDocumentProperties("Company").Value = TextBox4.Text
        .BuiltinDocumentProperties("Manager").Value = TextBox5.Text
        .BuiltinDocumentProperties("Subject").Value = TextBox6.Text
        .BuiltinDocumentProperties("Category").Value = TextBox7.Text
        .BuiltinDocumentProperties("Hyperlink base").Value = TextBox8.Text
        .BuiltinDocumentProperties("Comments").Value = TextBox9.Text
        .BuiltinDocumentProperties("Keywords").Value = TextBox10.Text
    End With
    objWD.ActiveDocument.Close True
End Sub