Wordファイルを開いて、テキストファイルに保存

2024.02.17

Wordファイルを開いてWordの内容をテキストファイルに変換して保存します。

' ------------------------------------------------------------
' 説明：Wrodファイルを開いてテキストファイルに保存（Shift-JIS）
' 引数：1:Wrodファイル名
'       2:出力するテキストファイル名
' 補足：Wordファイルは処理完了時に閉じる
' ------------------------------------------------------------
Sub WordOpenOutToText(in_filename As String, out_filename As String)
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    
    On Error GoTo ErrProc
    
    Set WordApp = New Word.Application
    
    ' Wordを表示する
    WordApp.Visible = True
  
    ' 指定したWordファイルを起動します。
    Set WordDoc = WordApp.Documents.Open(filename:=in_filename, ReadOnly:=True)
 
    ' テキストファイルで出力
    WordDoc.SaveAs filename:=out_filename, FileFormat:=wdFormatText
 
    WordDoc.Close savechanges:=False
    WordApp.Quit

    Set WordDoc = Nothing
    Set WordApp = Nothing
 
    Exit Sub
 
ErrProc:
    ' エラー処理

    MsgBox "Err.Number=" & Err.Number & vbCrLf & "Err.Descriptio" & Err.Description, vbExclamation, "エラー"
    
    If Not WordDoc Is Nothing Then
        WordDoc.Close
    End If
    
    WordApp.Quit
End Sub

UTF-8で保存するには以下を使用。

' ------------------------------------------------------------
' 説明：Wrodファイルを開いてテキストファイルに保存（UTF-8）
' 引数：1:Wrodファイル名
'       2:出力するテキストファイル名
' 補足：Wordファイルは処理完了時に閉じる
' ------------------------------------------------------------
Sub WordOpenOutToUTF8(in_filename As String, out_filename As String)
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    
    On Error GoTo ErrProc
    
    Set WordApp = New Word.Application
    
    ' Wordを表示する
    WordApp.Visible = True
  
    ' 指定したWordファイルを起動します。
    Set WordDoc = WordApp.Documents.Open(filename:=in_filename, ReadOnly:=True)
 
    ' UTF-8 テキストファイルで出力
    WordDoc.SaveAs filename:=out_filename, Encoding:=msoEncodingUTF8, _
            FileFormat:=wdFormatUnicodeText
    ' https://learn.microsoft.com/ja-jp/office/vba/api/office.msoencoding
    ' https://learn.microsoft.com/ja-jp/office/vba/api/word.wdsaveformat
    
 
    WordDoc.Close savechanges:=False
    WordApp.Quit

    Set WordDoc = Nothing
    Set WordApp = Nothing
 
    Exit Sub
 
ErrProc:
    ' エラー処理

    MsgBox "Err.Number=" & Err.Number & vbCrLf & "Err.Descriptio" & Err.Description, vbExclamation, "エラー"
    
    If Not WordDoc Is Nothing Then
        WordDoc.Close
    End If
    
    WordApp.Quit
End Sub

出力フォーマットは以下を参照
https://learn.microsoft.com/ja-jp/office/vba/api/office.msoencoding
https://learn.microsoft.com/ja-jp/office/vba/api/word.wdsaveformat

【補足】

Word.Application を使用しています。
初期設定では、エラーが発生するので、参照設定「Microsoft Word 16.0 Object Library」の設定
が必要です。

【改訂】
エラー処理を追加 (2025/07/21)

コメント