ich möchte Worddateien Metadaten mitgeben.
Dazu benutze ich folgenden Code, der für Excel auch prima funktioniert.
Bei PowerPoint will er die Datei erst nicht öffnen und gibt mir einen Fehler aus. Öffne ich die jeweilige Datei per Hand und schließe sie wieder. Und gehe im Debug-Modus weiter, dann funktioniert es auf einmal.
Bei Word wird die Datei gar nicht erst geöffnet und somit auch keine Eigenschaften übergeben.
An was kann das liegen?
Hier der benutzte Code:
Option Explicit
Sub DocuPropertiesInMSDocs()
Dim objPPApp As Object ' PowerPoint Application
Dim objPPFile As Object ' PowerPoint Document
Dim objWWApp As Object ' WinWord Application
Dim objWWFile As Object ' WinWord Document
Dim wbXL As Workbook ' Excel _Workbooks
Dim sDirName As String ' Verzeichnis
Dim sFileName As String ' Dateiname
dim quelldatei as string
dim jahr as integer
dim monat as string
jahr = 2014
monat = "01"
quelldatei = C:\datei.doc
'WIndows Word Objekt erstellen
Set objWWApp = CreateObject("Word.Application")
' Powerpoint Objekt erstellen
Set objPPApp = CreateObject("PowerPoint.Application")
'Word
If InStr(quelldatei, ".doc") Or InStr(quelldatei, ".docx") Then
'öffnet die hochzuladende datei
On Error Resume Next
Set objWWFile = objWWApp.Documents.Open(quelldatei)
If Err.Number 0 Then
Workbooks(wbname).Worksheets(4).Cells(fehler, 5) = "Fehler! Word Datei _
konnte nicht geöffnet werden!"
'aufruf der fehlerprozedur
mistake
End If
On Error GoTo 0
With objWWFile
On Error Resume Next
'Jahr hinzufügen
.CustomDocumentProperties.Add _
Name:="Jahr", LinkToContent:=False, _
Type:=msoPropertyTypeString, Value:=jahr
'Monat hinzufügen
.CustomDocumentProperties.Add _
Name:="Monat", LinkToContent:=False, _
Type:=msoPropertyTypeString, Value:=monat
'Titel hinzufügen
' .BuiltinDocumentProperties
' objWWFile("Title") = bericht
.Save
.Close
On Error GoTo 0
End With
End If
'Power Point
If InStr(quelldatei, ".ppt") Or InStr(quelldatei, ".pptx") Then
Set objPPFile = objPPApp.Presentations.Open(quelldatei)
With objPPFile
On Error Resume Next
'Jahr hinzufügen
.CustomDocumentProperties.Add Name:="Jahr", _
LinkToContent:=False, _
Type:=msoPropertyTypeString, _
Value:=jahr
'Monat hinzufügen
.CustomDocumentProperties.Add Name:="Monat", _
LinkToContent:=False, _
Type:=msoPropertyTypeString, _
Value:=monat
If Err.Number 0 Then
'Eintrag in Fehlerdokumenmt
Workbooks(wbname).Worksheets(4).Cells(fehler, 5) = "Fehler! Eigenschaft _
konnte nicht gesetzt werden!"
'aufruf der fehlerprozedur
mistake
End If
On Error GoTo 0
.Save
.Close
End With
End If
Set objPPApp = Nothing
set objWWApp = Nothing
End sub