ワードの履歴情報を消すマクロ

質問

お世話になっております。ワード2000を使用しています。
大量のワードをＰＤＦに変換しているのですが、ワードの履歴があり１件ずつ履歴のチェックを外しています。
最近自動マクロを使用し、開いたファイルのチェックを外すようにしているのですが、フォルダ内のファイル全てに関してチェックを外すマクロを作りたいのですが出来ますでしょうか？又はそのようなフリーソフトがあれば教えて下さい。

ちなみに自動マクロで作成したものは下記の通りです。

Sub Macro2()

If ActiveWindow.View.SplitSpecial = wdPaneNone Then
ActiveWindow.ActivePane.View.Type = wdPrintView
Else
ActiveWindow.View.Type = wdPrintView
End If
With ActiveDocument
.TrackRevisions = False
.PrintRevisions = False
.ShowRevisions = False
End With
End Sub

回答No.1

neKo_deux · ベストアンサー

> ちなみに自動マクロで作成したものは下記の通りです。

こちらは今開いているファイルを処理する手順ですね。
1)あるファイルを開く、履歴チェックを外す、上書き保存、閉じるを行うマクロを作ります。
2)あるファイルを指定できるように変更します。
3)そのマクロを多数のファイルに対して実行させる新しいマクロを作ります。
という手順でどうでしょうか？

--
1)
もう一度自動記録で、"C:\Temp\test.doc"というファイルを処理して、上書き保存、閉じるを行うマクロを記録してみてください。
多分、こんな感じです。

Sub Macro3()
　　Documents.Open FileName:="C:\Temp\test.doc", Conf…
　　　　…
　　　　…
～今記録しているのと同じような処理～
　　ActiveDocument.Save
　　ActiveDocument.Close
End Sub

2)
次に、このマクロを書き換えて、指定したファイルを処理するように変更します。
上の例の１、２行目を、

Sub Macro3()
Documents.Open FileName:="C:\Temp\test.doc", …
↓
Sub Macro3(strFilename as String)
Documents.Open FileName:=strFilename, …

とします。

3)
続いて、このマクロを呼び出すマクロを作成します。

Sub MacroAll()
Call macro3("C:\temp\test1.doc")
Call macro3("C:\temp\test2.doc")
Call macro3("C:\temp\test3.doc")
…(ファイル数分)…
End Sub

で、上のファイル数分手で打ち込むのは大変ですので、

Vector - ダウンロード>Windows95/98/Me>ユーティリティ>ファイル管理>ファイル一覧
http://www.vector.co.jp/vpack/filearea/win95/util/file/list/index.html

のようなソフトを利用して、

C:\temp\test1.doc
C:\temp\test2.doc
C:\temp\test3.doc

のようなテキストを取得し、
「C:\temp」→「 Call macro3("C:\temp」
「.doc」→「.doc")」
のような置換処理を行ってVBAのソースコードにして貼り付けるのが楽です。

--
> フォルダ内のファイル全てに関して

高度なVBAを使えば可能なんですが…取り敢えずは上記の方法が簡単なハズ。

参考URL：

http://www.vector.co.jp/vpack/filearea/win95/util/file/list/index.html

お礼

ご回答ありがとうございます。
試してみます

回答No.2

akamanbo

Sub フォルダ内繰り返し実行()

Dim Fs As FileSearch
Dim myFile As Variant
Dim myDoc As Document
Dim strCurName As String
Dim strNewName As String
Dim i As Long

Application.Visible = False　'処理の高速化するときには非表示で実行

Set Fs = Application.FileSearch
With Fs
.NewSearch
.FileName = "*.doc" ' ファイル形式を指定
.LookIn = "C:\ファイル\新しいフォルダ" '処理対象フォルダを指定
.FileType = msoFileTypeWordDocuments
.SearchSubFolders = True ' サブフォルダ内も実行
.Execute _
SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending
End With
For Each myFile In Fs.FoundFiles
i = i + 1
'ファイルを開く
Set myDoc = Documents.Open( _
FileName:=myFile)

Macro1　'ここに、別に作っておいた、ファイルを開くたびに実行するマクロ名を書く。

myDoc.Save　'保存

myDoc.Close　 'ファイルを閉じる

Next

Application.Visible = True

MsgBox "完了しました。"

End Sub

お礼

ありがとうございます。かなり作業時間の短縮になります。