Memo/2004-05-10

Word 関連情報 †

サンプルコード †

ページ単位でファイルに保存するマクロ †

' ページ単位でファイルに保存するマクロ
Sub PageToDoc()
    Dim strFilePath
    Dim strPageList
    Dim strPageArray
    Dim strPageFromTo
    Dim nPageFrom
    Dim nPageTo
    
    strFilePath = "D:\home\edu\word\test\page_" ' 保存先
    strPageList = "1,2-3,4,5-6,7"   ' ページ数の指定。
    strPageArray = Split(strPageList, ",")
    For Each strPageFromTo In strPageArray
        GetPageFromTo strPageFromTo, nPageFrom, nPageTo
        Debug.Print "nPageFrom = " & nPageFrom & ", " & "nPageTo = " & nPageTo
        SaveAsPageFromTo strFilePath, nPageFrom, nPageTo
    Next
    
End Sub

' ページの開始と終了を求める
Function GetPageFromTo(ByVal strPageFromTo, ByRef nPageFrom, ByRef nPageTo)
    Dim strPageArray
    strPageArray = Split(strPageFromTo, "-")
    
    nPageFrom = -1
    nPageTo = -1
    
    ' 要素数を求める
    nCount = UBound(strPageArray, 1) - LBound(strPageArray, 1) + 1
    If nCount = 1 Then
        nPageFrom = CInt(strPageArray(0))
        nPageTo = strPageArray(0)
    ElseIf nCount = 2 Then
        nPageFrom = CInt(strPageArray(0))
        nPageTo = strPageArray(1)
    End If
    
End Function

' 指定ページをファイルに保存
Function SaveAsPageFromTo(ByVal strFilePath, ByVal nPageFrom, ByVal nPageTo)
    For i = nPageFrom To nPageTo
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=i ' 指定ページに移動
        Selection.GoTo What:=wdGoToBookmark, Name:="\page"          ' ページを選択
        Selection.Copy                                              ' ページをコピー
        If i <> nPageFrom Then
            Documents.Open strFilePath & nPageFrom                  ' 既存の文書をオープン
            Selection.EndKey Unit:=wdStory                          ' 文書の最後に移動
        Else
            Documents.Add DocumentType:=wdNewBlankDocument          ' 新規に作成
        End If
        Selection.PasteAndFormat (wdPasteDefault)                   ' ページを貼り付け
        Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend ' 選択を解除
        If i <> nPageFrom Then
            ActiveDocument.SaveAs FileName:=strFilePath & nPageFrom ' 既存の文書を更新
        Else
            ActiveDocument.SaveAs FileName:=strFilePath & i         ' 新規に保存
        End If
        ActiveWindow.Close
    Next i
End Function

VBScript 関連情報 †

サンプル †

テキストファイルを連結するサンプル †

' AppendFile.vbs
' 使い方：
' 1. DIR_SRC にコピー元のファイルがあるフォルダ名を指定します。
' 2. DIR_DST にコピー先のフォルダ名を指定します。
' 3. FILE_ADD に追加するテキストファイルを記述します。
' 4. AppendFile.vbs をダブルクリックします。
'    DIR_DST の場所に連結されたファイルが作成されます。
' 
Const DIR_SRC = "D:\home\edu\VBScript\AppendFile\src" ' コピー元のフォルダ名
Const DIR_DST = "D:\home\edu\VBScript\AppendFile\dst" ' コピー先のフォルダ名
Const FILE_ADD = "D:\home\edu\VBScript\AppendFile\add.txt" ' 追加するテキストファイル

AppendFile

Sub AppendFile
     Dim fso
     Set fso = CreateObject("Scripting.FileSystemObject")
     Dim folder
     Set folder = fso.GetFolder( DIR_SRC )
     Dim strFileName ' コピー元のファイル名が入ります
     Dim txtFile1
     Dim txtFile2
     Dim txtFile3
     Dim strMargeText ' 文字列連結用変数
     For Each strFileName In folder.Files
         Set txtFile1 = fso.OpenTextFile( strFileName, 1, False )
         Set txtFile2 = fso.OpenTextFile( FILE_ADD, 1, False )
         strMargeText = txtFile1.ReadAll & txtFile2.ReadAll
         Set txtFile3 = fso.CreateTextFile( DIR_DST & "\" & fso.GetFileName(strFileName) , True)
         txtFile3.WriteLine( strMargeText )
     Next
End Sub