Word VBA ファイル操作

Option Explicit

   Type 属性 'ユーザ定義型(構造体)を宣言
      フルパス As String
      ファイル名 As String
      フォルダパス As String
      上位フォルダパス As String
      拡張子 As String
      拡張子無しファイル名 As String
   End Type
   
   Dim ファイルシステムオブジェクト As Object          ' FileSystemObject
   
   Dim 開始日時 As Variant
   Dim 終了日時 As Variant


Sub キリル文字をShiftJISに変換()
   Dim 対象ファイルサンプル As 属性
   Dim 変換ファイル As 属性
   Dim フォルダ As Object
   Dim ファイル As Object

   
   '文字コード変換するファイルを指定
   MsgBox "文字コード変換は、指定フォルダの指定拡張子の全てのファイルを対象にします。" _
   & vbNewLine & "文字コード変換する対象ファイルのどれか一つを指定して下さい。"
   
   対象ファイルサンプル = ファイル属性("テキストファイル", "*.txt;*.csv")

   Debug.Print 対象ファイルサンプル.フルパス
   Debug.Print 対象ファイルサンプル.ファイル名
   Debug.Print 対象ファイルサンプル.フォルダパス
   Debug.Print 対象ファイルサンプル.上位フォルダパス
   Debug.Print 対象ファイルサンプル.拡張子

'Stop
   開始日時 = Now                ' 開始時刻を変数に格納します。
    
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   
   Set フォルダ = ファイルシステムオブジェクト.GetFolder(対象ファイルサンプル.フォルダパス)
   
   '変換ファイルの保存するフォルダを作成
    ''保存フォルダが存在するかどうか調べます
'    Stop
    If ファイルシステムオブジェクト.FolderExists(対象ファイルサンプル.上位フォルダパス & "\ShiftJIS") Then
      '変換ファイルを登録するフォルダは、既存
    Else
      '保存用のフォルダを作成
       ファイルシステムオブジェクト.CreateFolder 対象ファイルサンプル.上位フォルダパス & "\ShiftJIS"
    End If

'   既存のファイル形式指定の状態 = Application.Options.ConfirmConversions

   '★指定ファイルの存在するフォルダの、全てのファイルを対象に検索
      For Each ファイル In フォルダ.Files
      
         If Right(ファイル.Name, Len(ファイル.Name) - InStrRev(ファイル.Name, ".")) _
         = 対象ファイルサンプル.拡張子 Then
         
            変換ファイル = ファイル名抽出(ファイル.Path)
         
         '*************データの読み込み***********
            Documents.Open _
               FileName:=変換ファイル.フルパス, _
               ReadOnly:=False, _
               AddToRecentFiles:=False, _
               Revert:=False, _
               Encoding:=1251
         
            ActiveDocument.SaveAs _
               FileName:=変換ファイル.上位フォルダパス & "\ShiftJIS\" _
               & 変換ファイル.拡張子無しファイル名 & "ShiftJIS." & 変換ファイル.拡張子, _
               FileFormat:=wdFormatText, _
               EmbedTrueTypeFonts:=False, _
               Encoding:=932, _
               LineEnding:=wdCRLF
'         Stop
            ActiveDocument.Close
            
         End If
         
      Next '★ファイル
   
'   Application.Options.ConfirmConversions = 既存のファイル形式指定の状態
   Set ファイルシステムオブジェクト = Nothing
   
   終了日時 = Now
   MsgBox "処理を終了しました。" & vbNewLine & "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub


Function ファイル属性(ファイル区分 As String, 拡張子 As String) As 属性

   'GetOpenFilename はExcelでしか使えない
'   ファイル属性.フルパス = Application.GetOpenFilename(ファイル区分と拡張子)
   
   Dim ファイルを開くダイアログ As FileDialog

   Set ファイルを開くダイアログ = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
   
   With ファイルを開くダイアログ
      .AllowMultiSelect = False
      .Title = "処理対象のファイルの一つを指定してください。"
'      .InitialFileName = "D:\"     '初期表示パス
      .InitialFileName = ThisDocument.Path
      .Filters.Clear
      .Filters.Add ファイル区分, 拡張子, 1
      If .Show = -1 Then
         ファイル属性.フルパス = .SelectedItems(1)
         ファイル属性.ファイル名 = Dir(ファイル属性.フルパス)
         ファイル属性.フォルダパス = Left(ファイル属性.フルパス, InStrRev(ファイル属性.フルパス, "\") - 1)
         ファイル属性.上位フォルダパス = Left(ファイル属性.フォルダパス, InStrRev(ファイル属性.フォルダパス, "\") - 1)
         ファイル属性.拡張子 = Right(ファイル属性.フルパス, Len(ファイル属性.フルパス) - InStrRev(ファイル属性.フルパス, "."))
      Else
         End
      End If
   End With
End Function


Function ファイル名抽出(フルパス As String) As 属性
   With ファイル名抽出
      .フルパス = フルパス
      .ファイル名 = Dir(フルパス)
      .フォルダパス = Left(フルパス, InStrRev(フルパス, "\") - 1)
      .上位フォルダパス = Left(ファイル名抽出.フォルダパス, InStrRev(ファイル名抽出.フォルダパス, "\") - 1)
      .拡張子 = Right(フルパス, Len(フルパス) - InStrRev(フルパス, "."))
      .拡張子無しファイル名 = Left(ファイル名抽出.ファイル名, InStr(ファイル名抽出.ファイル名, ".") - 1)
   End With
End Function

Sub OpenDoc()
    Documents.Open FileName:="C:\MyFiles\MyDoc.doc", ReadOnly:=True
End Sub

Sub OpenDoc2()
    Dim fmt As Variant
    fmt = Application.FileConverters("WordPerfect6x").OpenFormat
    Documents.Open FileName:="C:\MyFiles\Test.wp", Format:=fmt
End Sub

Dim strDocEncoding As String

If Application.DefaultWebOptions.Encoding _
        = msoEncodingWestern Then
    strDocEncoding = "欧文"
Else
    strDocEncoding = "その他"
End If

Sub SaveAsRTF()
    ActiveDocument.SaveAs FileName:="Text.rtf", _
        FileFormat:=wdFormatRTF
End Sub

Sub SaveAsTextFile()
    Dim strDocName As String
    Dim intPos As Integer

    'ファイル名の拡張子の位置を探します。
    strDocName = ActiveDocument.Name
    intPos = InStrRev(strDocName, ".")

    If intPos = 0 Then

        '文書が保存されていない場合、
        'ファイル名を指定するように要求します。
        strDocName = InputBox("Please enter the name " & _
            "of your document.")
    Else

        '拡張子を削除して、".txt" 拡張子を追加します。
        strDocName = Left(strDocName, intPos - 1)
        strDocName = strDocName & ".txt"
    End If

    '新しい拡張子でファイルを保存します。
    ActiveDocument.SaveAs FileName:=strDocName, _
        FileFormat:=wdFormatText
End Sub

Sub SaveWithConverter()

    Dim cnvWrdPrf As FileConverter

    'WordPerfect ファイル コンバータを検索し、
    'FileFormat コンバータ値のコンバータを使用して
    '文書を保存します。
    For Each cnvWrdPrf In Application.FileConverters
        If cnvWrdPrf.ClassName = "WrdPrfctWin" Then
            ActiveDocument.SaveAs FileName:="MyWP.doc", _
                FileFormat:=cnvWrdPrf.SaveFormat
        End If
    Next cnvWrdPrf

End Sub

Sub SaveWithPassword(docCurrent As Document, strPWD As String)
    With docCurrent
        .SaveAs WritePassword:=strPWD
    End With
End Sub

Sub ShowSaveAsDialog()
    'FileDialog オブジェクトの変数を宣言します。
    Dim dlgSaveAs As FileDialog

    '[名前を付けて保存] ダイアログ ボックスの FileDialog オブジェクトを作成します。
    Set dlgSaveAs = Application.FileDialog( _
        FileDialogType:=msoFileDialogSaveAs)
    dlgSaveAs.Show

    'オブジェクトの変数に Nothing を設定します。
    Set dlgSaveAs = Nothing
End Sub

Sub ShowFileDialog()
    'FileDialog オブジェクトの変数を宣言します。
    Dim dlgOpen As FileDialog

    '[ファイルを開く] ダイアログ ボックスの FileDialog オブジェクトを作成します。
    Set dlgOpen = Application.FileDialog( _
        FileDialogType:=msoFileDialogOpen)
    With dlgOpen
        .AllowMultiSelect = True
        .Show
    End With

    'オブジェクトの変数に Nothing を設定します。
    Set dlgOpen = Nothing
End Sub

Sub Main()

    'FileDialog オブジェクトの変数を宣言します。
    Dim fd As FileDialog

    '[参照] ダイアログ ボックスの FileDialog オブジェクトを作成します。
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    '選択した各アイテムのパスを保存する
    '変数を宣言します。パスは文字列型 (String) ですが、
    '変数はバリアント型 (Variant) である必要があります。Each...Next ルーチンは、
    'バリアント型 (Variant) およびオブジェクト型 (Object) の値でのみ動作します。
    Dim vrtSelectedItem As Variant

    'With...End With ブロックを使用して、FileDialog オブジェクトを参照します。
    With fd

        'GIF イメージおよび JPEG イメージを含むフィルタを追加し、一覧の最初のアイテムとして設定します。
        '複数の拡張子を対象とする場合は、; で区切って列挙します。
        .Filters.Add "イメージ", "*.gif; *.jpg; *.jpeg", 1

        'Show メソッドを使用して [参照] ダイアログ ボックスを表示し、ユーザーのアクションを取得します。
        'ユーザーがアクション ボタンをクリックした場合
        If .Show = -1 Then

            'FileDialogSelectedItems コレクション内のすべての文字列を調べます。
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem は、選択した各アイテムのパスを保存する文字列型 (String) の値です。
                'このパスで使用したいファイルの I/O 関数があれば、使用できます。
                'この使用例では、単にメッセージ ボックスにパスを表示します。
                MsgBox "選択したアイテムのパス : " & vrtSelectedItem

            Next vrtSelectedItem
        'ユーザーが [キャンセル] をクリックした場合
        Else
        End If
    End With

    'オブジェクトの変数に Nothing を設定します。
    Set fd = Nothing

End Sub

Sub Main()

    'FileDialog オブジェクトの変数を宣言します。
    Dim fd As FileDialog

    '[参照] ダイアログ ボックスの FileDialog オブジェクトを作成します。
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    '選択した各アイテムのパスを保存する
    '変数を宣言します。パスは文字列型 (String) ですが、
    '変数はバリアント型 (Variant) である必要があります。Each...Next ルーチンは、
    'バリアント型 (Variant) およびオブジェクト型 (Object) の値でのみ動作します。
    Dim vrtSelectedItem As Variant

    'With...End With ブロックを使用して、FileDialog オブジェクトを参照します。
    With fd

        'Show メソッドを使用して [参照] ダイアログ ボックスを表示し、ユーザーのアクションを取得します。
        'ユーザーがアクション ボタンをクリックしました。
    If .Show = -1 Then

            'FileDialogSelectedItems コレクション内のすべての文字列を調べます。
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem は、選択した各アイテムのパスを含む文字列型 (String) の値です。
                'このパスで使用したいファイルの I/O 関数があれば、使用できます。
                'この使用例では、単にメッセージ ボックスにパスを表示します。
                MsgBox "パス: " & vrtSelectedItem

            Next vrtSelectedItem
        'ユーザーが [キャンセル] をクリックしました。
    Else
        End If
    End With

    'オブジェクトの変数に Nothing を設定します。
    Set fd = Nothing

End Sub

Sub Main()

    'FileDialog オブジェクトの変数を宣言します。
    Dim fd As FileDialog

    '[参照] ダイアログ ボックスの FileDialog オブジェクトを作成します。
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    '選択した各アイテムのパスを保存する
    '変数を宣言します。パスは文字列型 (String) ですが、
    '変数はバリアント型 (Variant) である必要があります。Each...Next ルーチンは、
    'バリアント型 (Variant) およびオブジェクト型 (Object) の値でのみ動作します。
    Dim vrtSelectedItem As Variant

    'With...End With ブロックを使用して、FileDialog オブジェクトを参照します。
    With fd

        'C:\ ドライブへの初期パスを設定します。
        .InitialFileName = "C:\"

        'Show メソッドを使用して [参照] ダイアログ ボックスを表示し、ユーザーのアクションを取得します。
        'ユーザーがアクション ボタンをクリックした場合
        If .Show = -1 Then

            'FileDialogSelectedItems コレクション内のすべての文字列を調べます。
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem は、選択した各アイテムのパスを保存する文字列型 (String) の値です。
                'このパスで使用したいファイルの I/O 関数があれば、使用することができます。
                'この使用例では、単にメッセージ ボックスにパスを表示します。
                MsgBox "選択したアイテムのパス : " & vrtSelectedItem

            Next vrtSelectedItem
        'ユーザーが [キャンセル] をクリックした場合
        Else
        End If
    End With

    'オブジェクトの変数に Nothing を設定します。
    Set fd = Nothing

End Sub