VBAで、wordに名前を付けて、保存。

質問

VBA熟練者の方々にご相談です。

以下の工程を既存のマクロに追加したいのですが、コードのご教授お願いいたします。

現状

下記のVBAで、template.docxを立ち上げ、エクセルのテキストを転記している状態です。
ーーーーーーーーーーーーーーーーーーー
Sub EXCEL_WORD04()
　Dim WordApp As Object
Dim WordDoc As Word.Document
Dim I, lRow As Long
Dim ExcelText
Set WordApp = CreateObject("Word.Application")

WordApp.Visible = True

lRow = Cells(Rows.Count, "A").End(xlUp).Row '

Set WordDoc = WordApp.Documents.Open("H:\***\***\***\template.docx")

With WordApp

For I = 2 To lRow
ExcelText = Cells(I, "A").Text & vbLf
.Selection.TypeText ExcelText
Next I
End With

End Sub

ーーーーーーーーーーーーーーーーーーー

追加したい事。

template.docxが保存されているフォルダに、
“転記した日”_常勤役員会報告書（XX統計“転記した日の前の月”月期について）として保存できるようにしたいです。
(例)220804_常勤役員会報告書（XX統計7月期について）

よろしくお願いいたします

回答No.4

HohoPapa · ベストアンサー

こんな感じでいかがでしょうか。

Sub EXCEL_WORD04()
Dim WordApp As Object
Dim WordDoc As Word.Document
Dim I, lRow As Long
Dim ExcelText
Dim wkTuki As Long
Dim PutFName As String

Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
lRow = Cells(Rows.Count, "A").End(xlUp).Row
Set WordDoc = WordApp.Documents.Open("D:\TestDir\hoge.docx")

With WordApp
For I = 2 To lRow
ExcelText = Cells(I, "A").Text & vbLf
.Selection.TypeText ExcelText
Next I
End With

'名前を組み立てて保存
wkTuki = Month(DateSerial(Year(Now), Month(Now), 1) - 1)
PutFName = _
Format(Now, "eeMMDD") & _
"_常勤役員会報告書（XX統計" & _
Format(wkTuki, "00") & "月期について）"
WordDoc.SaveAs2 Filename:="D:\TestDir\" & PutFName

'後処理
WordDoc.Close savechanges:=False
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing

End Sub

お礼

ありがとうございます。
大変たすかりました。

回答No.3

HohoPapa

#2への補足です。

(例)220804_常勤役員会報告書（XX統計7月期について）
(例)220804_常勤役員会報告書（XX統計12月期について）
としたい場合は

'名前を組み立てて保存
　wkTuki = Month(DateSerial(Year(Now), Month(Now), 1) - 1)
　PutFName = _
　　Format(Now, "YYYYMMDD") & _
　　"_常勤役員会報告書（XX統計" & _
　　Format(wkTuki, "0") & "月期について）"
　WordDoc.SaveAs2 Filename:="D:\TestDir\" & PutFName

(例)220804_常勤役員会報告書（XX統計07月期について）
(例)220804_常勤役員会報告書（XX統計12月期について）
としたい場合は

'名前を組み立てて保存
　wkTuki = Month(DateSerial(Year(Now), Month(Now), 1) - 1)
　PutFName = _
　　Format(Now, "YYYYMMDD") & _
　　"_常勤役員会報告書（XX統計" & _
　　Format(wkTuki, "00") & "月期について）"
　WordDoc.SaveAs2 Filename:="D:\TestDir\" & PutFName

となります。

補足

ありがとうございます。

ファイル名ですが、和暦を忘れておりました。

(例)220804_常勤役員会報告書（XX統計令和4年7月期について）

とするには、どのようにしたらよいでしょうか。

ご教授お願いいたします。

回答No.2

HohoPapa

以下でいかがでしょうか。

Sub EXCEL_WORD04()
　Dim WordApp As Object
　Dim WordDoc As Word.Document
　Dim I, lRow As Long
　Dim ExcelText
　Dim wkTuki As Long
　Dim PutFName As String

　Set WordApp = CreateObject("Word.Application")
　WordApp.Visible = True
　lRow = Cells(Rows.Count, "A").End(xlUp).Row
　Set WordDoc = WordApp.Documents.Open("D:\TestDir\hoge.docx")

　With WordApp
　　For I = 2 To lRow
　　　ExcelText = Cells(I, "A").Text & vbLf
　　　.Selection.TypeText ExcelText
　　Next I
　End With

　'名前を組み立てて保存
　wkTuki = Month(DateSerial(Year(Now), Month(Now), 1) - 1)
　PutFName = _
　　Format(Now, "YYYYMMDD") & _
　　"_常勤役員会報告書（XX統計" & _
　　Format(wkTuki, "00") & "月期について）"
　WordDoc.SaveAs2 Filename:="D:\TestDir\" & PutFName

　'後処理
　WordDoc.Close savechanges:=False
　WordApp.Quit
　Set WordDoc = Nothing
　Set WordApp = Nothing

End Sub

回答No.1

chie65536（@chie65535）

変数「転記した日」と、変数「転記した日の前の月」に正しい値を設定する処理を追加して、
Set WordDoc = WordApp.Documents.Open("H:\***\***\***\template.docx")
の部分を
「"H:\***\***\***\template.docx"ファイルを、"H:\***\***\***\" & 転記した日 & "_常勤役員会報告書（XX統計" & 転記した日の前の月 & "月期について）.docx"ファイルにコピーする」
という処理と
「Set WordDoc = WordApp.Documents.Open("H:\***\***\***\" & 転記した日 & "_常勤役員会報告書（XX統計" & 転記した日の前の月 & "月期について）.docx")」
という処理に変える。