Excel VBA質問箱 IV

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

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


7998 / 76736 ←次へ | 前へ→

【74319】Re:Word-xml形式⇔Word変換VBA
発言  UO3  - 13/5/21(火) 21:01 -

引用なし
パスワード
   ▼PPNNOOPP さん:

こんばんは

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

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

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
1 hits

【74313】Word-xml形式⇔Word変換VBA PPNNOOPP 13/5/20(月) 23:27 質問
【74315】Re:Word-xml形式⇔Word変換VBA UO3 13/5/21(火) 10:02 発言
【74316】Re:Word-xml形式⇔Word変換VBA PPNNOOPP 13/5/21(火) 12:22 発言
【74317】Re:Word-xml形式⇔Word変換VBA PPNNOOPP 13/5/21(火) 13:13 発言
【74319】Re:Word-xml形式⇔Word変換VBA UO3 13/5/21(火) 21:01 発言

7998 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free