開いたファイルと同じ場所にある最新のcsvを差し込む

ソース見てる人は気づいてると思うが、私は異常系の処理(エラー対応)が全くできない。エラーが出たときに考えるタイプなので各自補完して欲しい。
そしてできれば教えて欲しい(´;ω;`)

さて、前回の封筒データ。こちらのワードファイル*1と同じ場所に置かれている最新のCSVと差込データを差し替えよう、です。
前回と合わせると、ファイルを開いたときに新しいcsvと新しいpngに差し替える感じです。
フォルダはこんな感じ
f:id:elve:20210801073153p:plain

最初の差込処理は、書式の確認とかもあるし、手動のほうがいいと思う。WORDのマクロ面倒だし←

Private Sub Document_Open()
Dim csvname As String: csvname = get_newestFile("csv")
Me.MailMerge.OpenDataSource Name:= _
Me.Path & "\" & csvname
ActiveDocument.MailMerge.ViewMailMergeFieldCodes = False
図差替
End Sub
Function get_newestFile(t As String) As String
 '指定拡張子の最新ファイル名取得
If Len(t) > 4 Then
get_newestFile = ""
Exit Function
End If
Dim p As String: p = Me.Path & "\"
Dim newest As Date
Dim filename As String
Dim taegetname As String
filename = Dir(p & "*." & t)
Do Until filename = ""
If FileDateTime(p & filename) > newest Then
newest = FileDateTime(p & filename)
taegetname = filename
End If
filename = Dir()
Loop
get_newestFile = taegetname
End Function
Sub 図差替()
Dim p As String: p = Me.Path & "\"
Dim se As Section
For Each se In Me.Sections
Dim he As HeaderFooter: Set he = se.Headers(wdHeaderFooterPrimary)
Dim sh As Shape: Set sh = he.Shapes("図 12")
Dim filename As String: filename = get_newestFile("png")
Dim newsh As Shape
Set newsh = he.Shapes.AddPicture(p & filename, False, True, , , sh.Width, sh.Height)
With newsh
.WrapFormat.Type = sh.WrapFormat.Type
.RelativeHorizontalPosition = sh.RelativeHorizontalPosition
.LeftRelative = sh.LeftRelative
.RelativeVerticalPosition = sh.RelativeVerticalPosition
.TopRelative = sh.TopRelative
.Top = sh.Top
.Left = sh.Left
.LockAnchor = sh.LockAnchor
End With
sh.Delete
newsh.Name = "図 12"
Next
End Sub

・・・・
・・・

うん
今回追加したの

        Me.MailMerge.OpenDataSource Name:= _
Me.Path & "\" & csvname

これだけだねwwwwww

*1:エクセルはブックで通じるけどワードはドキュメントで通じない感あるよね?

どのくらい面白かった?

星を押して送信してね

平均 0 / 5. Vote count: 0

是非フォローしてください

最新の情報をお伝えします

コメントする

メールアドレスが公開されることはありません。 が付いている欄は必須項目です