| |
はじめまして。らいでんです。
私もこちらへは初めての書き込みになります。
以下はサンプルです。VBEの[ツール]→[参照設定]で
「Microsoft Scripting Runtime」にチェックを入れてください。
処理の内容は大雑把に言えば、文書を順に開いてコピー＆新規文書に
ペーストしています。
留意すべき点としては、無限にコピー＆ペーストが行えるわけではなく
Wordファイルサイズの制限に引っかかるので
'ファイルサイズの制限
としている下の行の数値をお使いのWordのバージョンにあわせて
適当に調節してください。（2000以降は32MB。バージョンを明記の事）
もっとも、このサイズ制限の処理はいい加減です。^-^;
Sub Test()
Dim Fso As New FileSystemObject
Dim myFolder As Folder
Dim myFile As File
Dim NewDoc As Document
Dim OldDoc As Document
Dim myRng As Range
Dim myFlag As Boolean
Dim Fsize As Long
Const myPath = "C:\My Documents" 'フォルダ指定
myFlag = False
Set NewDoc = Documents.Add
Set myFolder = Fso.GetFolder(myPath)
For Each myFile In myFolder.Files
If myFile.Type Like "Microsoft Word 文書" _
And Not myFile Like "~$*" Then
Fsize = Fsize + myFile.Size
Debug.Print myFile.Size
'ファイルサイズの制限
If Fsize > 30000000 Then Exit For
Debug.Print myFile.Name
Set OldDoc = Documents.Open(myFile.Path)
DoEvents
With OldDoc
.Content.Copy
.Close False
End With
Set OldDoc = Nothing
Set myRng = NewDoc.Content
myRng.Collapse Direction:=wdCollapseEnd
If myFlag = True Then
myRng.InsertBreak Type:=wdPageBreak
End If
DoEvents
myRng.Paste
myFlag = True
End If
DoEvents
Next
Set myFile = Nothing
Set myFolder = Nothing
Set Fso = Nothing
Set myRng = Nothing
Set NewDoc = Nothing
End Sub
|
|
らいでん
- 03/4/21(月) 2:15 -
