Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

7994 / 76732

←次へ　｜　前へ→


	【74319】Re:Word-xml形式⇔Word変換VBA

UO3 - 13/5/21(火) 21:01 -


	引用なし

	パスワード

▼PPNNOOPP さん：

こんばんは

やはり、本来なら、WordVBA で　Wordの世界で処理すべきものなんでしょうね。
ただ、私自身、WordVBAも経験がありませんし、ここは ExcelVBAの板ですので
おっかなびっくり、ExcelVBAでコードを書いてみました。
結構処理時間はかかるかもしれませんしロジックの自信度も60%ぐらいですが・・・・

こちらで、１０ファイルぐらいで動かしても結構長くかかります。
ましてや　2000～4000ファイル　となると、う～ん・・・・ですねぇ。
まずは、１０個ぐらいで試してみてもらえますか？

Sub Sample()
　　Dim docapp As Object
　　Dim fso As Object
　　Dim myPath As String
　　
　　myPath = "c:\TEST"　　　'★フォルダパスは実際のものに
　　
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　Set docapp = CreateObject("Word.Application")
　　
　　Retrieve fso, fso.getfolder(myPath), docapp
　　
　　docapp.Quit
　　
　　MsgBox "処理が完了しました"
　　
End Sub

Sub Retrieve(fso As Object, folder As Object, docapp As Object)
　　Dim subfolder As Object
　　Dim file As Object
　　Dim doc As Object
　　Dim nName As String
　　
　　'カレントフォルダ内のファイルを列挙
　　For Each file In folder.Files
　　　　Set doc = docapp.Documents.Open(Filename:=file.Path)
　　　　Application.DisplayAlerts = False
　　　　nName = fso.getparentfoldername(file.Path) & "\" & fso.getbasename(file.Path) & ".doc"
　　　　doc.SaveAs2 Filename:=nName, FileFormat:=0　 'wdFormatDocument
　　　　Application.DisplayAlerts = True
　　　　doc.Close
　　Next
　　
　　For Each subfolder In folder.SubFolders
　　　　'再帰的呼び出し
　　　　Retrieve fso, subfolder, docapp
　　Next
　　

End Sub

2 hits

▼

【74313】Word-xml形式⇔Word変換VBA PPNNOOPP 13/5/20(月) 23:27