平成16年2月19日 ≪宛名≫ 様新製品のご案内 凸凹嘘800商事 拝啓 新緑の候、、、と言うには早すぎる季節ですが、いかがお過ごしですか? 落ち込んだりもしたけれど私は元気です! さて、今回は弊社で新開発された≪宛名の人の趣味にあわせた商品≫のご案内をさせていただきます。 これは… |
Sub saveSubDoc() Dim lngDocNum As Integer Dim strFileNum As String Dim strFileName As String Dim strShouhin As String lngDocNum = Documents.Count With ThisDocument.MailMerge ' 差込フィールドの非表示 .ViewMailMergeFieldCodes = False ' 文書の一番最初に登場する差込フィールドの取得 = 宛名 .Fields(1).Select strFileNum = Selection.Fields(1).Result ' 文書の二番目に登場する差込フィールドの取得 = 宛名の人の趣味にあわせた商品 .Fields(2).Select strShouhin = Selection.Fields(1).Result ' 文書に差し込みを行う .Destination = wdSendToNewDocument With .DataSource ' 現在表示しているレコードの差込 .FirstRecord = .ActiveRecord .LastRecord = .ActiveRecord End With .Execute Pause:=True End With ' 新規文書が作成されるまで待ち合わせ Do DoEvents Loop Until lngDocNum < Documents.Count ' ファイル名を指定して保存 Documents(1).SaveAs FileName:=strFileNum & "様あて" & strShouhin End SubこのVBAを実行すると、現在開いているファイルを別名でWordドキュメントとして保存します。
posted at 2004/02/19