excel VBAを利用し、テンプレートとなるワードファイルの一部分を

質問

excel VBAを利用し、テンプレートとなるワードファイルの一部分をエクセルデータで
置換を行い、新しいワードファイルとして保存するという処理を作成しています。

[環境]
Windows Vista
Office 2007
差し込み文書ではなく個別にファイルを作りたいという条件があります。

処理としては、
テンプレートを開く→置換を実施→別名で保存→テンプレートを変更せず閉じる
を繰り返し実施しています。
ただ、このやり方ですと最後の閉じる処理を行った際に、
「wordは、動作を停止しました」というエラーメッセージが頻繁に出てしまいます。
出来上がったファイル自体は問題なく読めているんですが。
処理自体に問題があるんでしょうか？
VBA自体初心者であり、他に良い方法などありましたらご教示いただけたら助かります。

#処理内容はだいぶ簡略化しています。
Public　Function　output_word2()
　　Dim　word　　　　　　　　As　New　word.Application
　　Dim　document　　　　　　As　word.document
　　Dim　file_name　　　　　　As　String
　　Dim　output　　　　　　　As　String
　　Dim　path　　　　　　　　As　String
　　Dim　row　　　　　　　　As　Integer

　　Sheets(CALC_SHEET).Select　'データ取得用シート

　　path　=　Application.ActiveWorkbook.path
　　file_name　=　path　&　"\xxxxxx.doc"　　　　　　　　　　'元の文書
　　row　=　3
　　Do
　　　　If　Range("B"　&　row).Value　=　""　Then
　　　　　　Exit　Do
　　　　End　If

　　　　With　word
　　　　　　.Documents.Open　Filename:=file_name
　　　　　　Set　document　=　.ActiveDocument
　　　　End　With

　　　　word.Selection.Find.Text　=　"{置換対象文字}"
　　　　word.Selection.Find.Forward　=　True
　　　　word.Selection.Find.Replacement.Text　=　Range("C"　&　row).Value
　　　　word.Selection.Find.Execute　,　,　,　,　,　,　,　,　,　,　wdReplaceAll

　　　　output　=　path　&　"\output\"　&　Range("C"　&　row).Value　 &　".doc"

　　　　document.SaveAs　Filename:=output　　　'置換後のword文書を別名で保存
　　　　document.Close　SaveChanges:=False
　　　　word.Quit
　　　　row　=　row　+　1
　　　　Set　word　=　Nothing
　　　　Set　document　=　Nothing
　　Loop
End　Function

回答No.1

Wendy02 · ベストアンサー

その元のコードは、癖になりますから、エラーが発生するとかいう以前に直した方がよいですね。時々、非VBAのプログラマの人にいますが、VBAは、ほとんど、予約語が存在しないので、変数名は、何でも付けられますが、それをそのまま使うと、他人からは、まったくコードを読めなくなってしまいます。エラーが発生しても原因がわかりにくくなります。

それから、ハングした後は、タスクマネージャーで、WinWord を削除しないと、エラーが繰り返すはずです。それで、メモリに残らないように、以下のように、エラーが発生したら、必ず、wdApp を外すようにします。

'//
　Sub WordDocDupulicate()
　Dim wdApp As Word.Application
　Dim wdDoc As Word.Document
　Dim wdRng As Word.Range
　Dim Fname　 As String
　Dim sOutput　As String

　Dim mPath　 As String
　Dim mRow　As Long
　Dim sh As Worksheet
　Set wdApp = New Word.Application

　Const CALC_SHEET As String = "Sheet1"　'←シート名
　Set sh = Worksheets(CALC_SHEET) 'データ取得用シート
　sh.Select

　mPath = ActiveWorkbook.Path & "\"
　Fname = mPath & "xxxxxx.doc"

　sOutput = mPath & "\"
　On Error GoTo ErrHandler
　'元の文書
　If Dir(Fname) = "" Then
　　MsgBox "元の文書がありません。", vbExclamation
　　GoTo ErrHandler
　End If
　mRow = 3
　Do
　　With wdApp
　　　Set wdDoc = .Documents.Open(Fname)
　　　Set wdRng = wdDoc.Content
　　End With
　　With wdRng.Find
　　　.Text = "[置換対象文字]"
　　　.Forward = True
　　　.Replacement.Text = Range("C" & mRow).Value
　　　.MatchCase = False
　　　.MatchWildcards = False
　　　.MatchFuzzy = True
　　　'.Execute Replace:=wdReplaceAll 'Ver Word2003
　　　.Execute , , , , , , , , , , wdReplaceAll
　　End With
　　sOutput = mPath & "test1\" & Range("C" & mRow).Value & ".doc"
　　wdDoc.SaveAs sOutput '置換後のword文書を別名で保存
　　wdDoc.Close False
　　mRow = mRow + 1
　Loop Until sh.Range("C" & mRow).Value = ""
　wdApp.Quit
ErrHandler:
　If Err.Number > 0 Then
　　MsgBox Err.Number & " : " & Err.Description
　Else
　　Beep '正常終了
　End If
　Set wdRng = Nothing
　Set wdDoc = Nothing
　Set wdApp = Nothing
　Set sh = Nothing
End Sub

お礼

修正ソースまで提示いただきありがとうございます。
VBAの例外処理など全く知らずに修正していた自分がちょっと怖くなりました＠＠；
知らない部分が多すぎて、前提が前提ではなくなっていました。

回答いただいたソースを元に修正をかけたところ
無事動作させることができました。
この度はご協力いただき、ありがとうございました。

VBAの奥深さも痛感いたしました・・。反省です。

回答No.2

mimeu

お役に立てるかどうかわかりませんが、ご質問で気がついた点を二つ。

(1)
> 「wordは、動作を停止しました」というエラーメッセージが頻繁に出てしまいます。
とのことですが
> word.Quit
と Ｗｏｒｄ を止めているからで、これは Ｌｏｏｐ 文の後に記述するべきです。

(2)
Ｅｘｃｅｌ のＣ列に新しく保存する文書の名前が入っているから Ｅｘｃｅｌ ＶＢＡ になさったのでしょうが、Ｗｏｒｄ文書が対象ですから、Ｗｏｒｄ ＶＢＡ の方も
トライなさることをおすすめします。世界が広がりますよ。

お礼

早速の回答ありがとうござました。
他の方の作成したVBAを修正していけるかと思って安易に考えていた部分があり、
VBAの奥深さを痛感いたしました。
きちんと学ばなければなりませんね＾＾；

word.Quitの件、アドバイスいただいた通り(先のWendy02さんのアドバイスも含めて)
修正しましたところエラーの頻発はなくなりました。

この度は、アドバイス頂きありがとうございました。
無事解決することができました。