| |
自己レスですんません。
解決しました。（単に代入のあと保存すればOKでした。）
ちなみにWord板の方が良かったですね。
Excelで作っていたものですから・・・
重ね重ねお詫びいたします。
ちなみにこんな感じです。見せられるようなソースではないですが、
良かったら利用してください。
Sub WordProperty()
Dim Msg As String
Dim FileName As String
Dim FilePath As String
Dim WordApp As Word.Application
Dim Wodrdoc As Word.Document
FilePath = Application.ActiveWorkbook.Path
Msg = " ディレクトリ=" + FilePath + "のファイルプロパティリストを作成します。"
MsgBox Msg
Application.ScreenUpdating = False
Worksheets("結果").Select
Range("A1:IV65536").Clear
Range("A1").Value = "ファイル名"
Range("B1").Value = "副題"
Range("C1").Value = "タイトル"
Range("D1").Value = "作成日時"
Range("E1").Value = "ページ数"
Range("F1").Value = "英文ワード数"
Range("G1").Value = "日本語文字数"
Range("H1").Value = "バイト数"
Range("I1").Value = "作者"
Range("J1").Value = "会社名"
Set WordApp = CreateObject("word.application")
WordApp.Visible = True
FileName = Dir(FilePath & "\*.doc")
i = 2
Do While FileName <> ""
Set Worddoc = WordApp.Documents.Open(FilePath & "\" & FileName)
Range("A" & i).Value = FileName
Range("B" & i).Value = Worddoc.BuiltinDocumentProperties("Subject")
Range("C" & i).Value = Worddoc.BuiltinDocumentProperties("Title")
Range("D" & i).Value = Str(Worddoc.BuiltinDocumentProperties("Creation Date"))
Range("E" & i).Value = Worddoc.BuiltinDocumentProperties("Number of Pages")
Range("F" & i).Value = Worddoc.BuiltinDocumentProperties(wdPropertyWords)
Range("G" & i).Value = Worddoc.BuiltinDocumentProperties("Number of Characters")
Range("H" & i).Value = Worddoc.BuiltinDocumentProperties("Number of Bytes")
Range("I" & i).Value = Worddoc.BuiltinDocumentProperties("Author")
Range("J" & i).Value = Worddoc.BuiltinDocumentProperties("Company")
Worddoc.BuiltinDocumentProperties("Company") = "test"
i = i + 1
Worddoc.Close
FileName = Dir()
Loop
WordApp.Quit
'オブジェクトのクリア
Set Worddoc = Nothing
Set WordApp = Nothing
End Sub
|
|
