[[20200829163928]]　『自動保存で上書きされないようにしたい』（96）　ページの最後に飛ぶ

『自動保存で上書きされないようにしたい』（96）

「指定した保存先にPDF形式・ファイル名を日付で保存する」マクロを作っています。
同じ日に実行するとPDFファイルが上書きされてしまうのを防ぎたいです。

得意先名をVLOOKUPで呼び出して表示させているのですが、「得意先名日付」なら被らないはずなので、そういったファイル名には出来ませんでしょうか？

もしくは、上書きしますか？と表示が出てファイル名が変更出来たり、ファイル名が「日付_1」となったり…というような上書きされないように出来ませんでしょうか？

どうぞよろしくお願いいたします。

Sub PDF()

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\保存先\" & Format(Date, "yyyymmdd"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True,IgnorePrintAreas:=False,OpenAfterPublish:=True

End Sub

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

 >Filename:= "\\保存先\" & Format(Date, "yyyymmdd"),

 Filename:= "\\保存先\" & Activesheet.Range("A1").Value & Format(Date, "yyyymmdd") & ".pdf"

 > Format(Date, "yyyymmdd")

 日付だけではなく、日時にする、というのではだめですか？

 Format(Date, "yyyymmddhhmmss")

 >ファイル名が「日付_1」となったり

 "日付_" & i

 などとして、ループで存在しないﾌｧｲﾙ名になるまでループする、
 という方法も。
（OK） 2020/08/29(土) 18:41

OK様

私がこんな風に、といった疑問一つ一つをわかりやすく教えていただきましてありがとうございます。
得意先名+日時で整理やデータ添付等が大変やりやすいPDFとして保存が出来ました。

.
Sub PDF()

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\保存先\" & ActiveSheet.Range("A1").Value & "様" & " " & Format(Now, "yyyymmddhhmm"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

.
.

.
.
後学のために教えていただけたら嬉しいのですが、もしループ処理をする場合どういった形にしたらよいでしょうか？

簡単なループ処理しかわからないなりに一応考えてはみたのですが、PDFの保存自体のループ処理となってしまい、「日付_1」～「日付_101」まで、保存を101回繰り返すことになってしまいました。

どうぞよろしくお願いいたします。

.
Sub PDF()

Dim i As Long
For i = 1 to 100 + 1

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\保存先\" & Format(Date, "yyyymmdd") & "_" & i , Quality:=xlQualityStandard, _
IncludeDocProperties:=True,IgnorePrintAreas:=False,OpenAfterPublish:=True

Next i

End Sub
（96） 2020/08/31(月) 15:44

 こんな感じです。参考まで。

Sub PDF_2()

 Dim i As Long
 Dim myfol As String
 Dim sredate As String
 Dim mysavepath As String
 Dim saveflag As Boolean
  myfol = "\\保存先" '保存先フォルダ
  strdate = Format(Date, "yyyymmdd") '日付
  mysavepath = myfol & "\" & strdate & ".pdf" '保存パス
  If Dir(mysavepath) <> "" Then '保存パスが存在したら
     saveflag = False 'フラグを立てFALSEを代入
     i = 0 'カウンタの初期化
     Do Until saveflg = True ’フラグがFALSEの間はループする
      i = i + 1 'カウントアップ
      mysavepath = myfol & "\" & strdate & "_" & Format(i, "00") & ".pdf" ’保存パスの再指定
      If Dir(mysavepath) <> "" Then ' 保存パスが存在したら
         saveflag = False 'フラグをFALSEにする
      Else '保存パスが存在しなかったら
         saveflg = True'フラグをTRUEにする/ループを抜ける
      End If
     Loop 'ループ
  End If
  'PDF保存実行
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mysavepath, Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
（OK） 2020/08/31(月) 18:17

 > Dim sredate As String

 ↓の間違いでした。

 Dim strdate As String
（OK） 2020/08/31(月) 18:19

  なんかボロボロでした。さらに修正2カ所です。

   Do Until saveflg = True ’フラグがFALSEの間はループする
  ↓
   Do Until saveflag = True ’フラグがFALSEの間はループする

      Else '保存パスが存在しなかったら
         saveflg = True'フラグをTRUEにする/ループを抜ける
  ↓
      Else '保存パスが存在しなかったら
         saveflag = True'フラグをTRUEにする/ループを抜ける
（OK） 2020/08/31(月) 18:28

 修正後のコードです。

Sub PDF_2()

 Dim i As Long
 Dim myfol As String
 Dim strdate As String
 Dim mysavepath As String
 Dim saveflag As Boolean
  myfol = "\\保存先" '保存先フォルダ
  strdate = Format(Date, "yyyymmdd") '日付
  mysavepath = myfol & "\" & strdate & ".pdf" '保存パス
  If Dir(mysavepath) <> "" Then '保存パスが存在したら
     saveflag = False 'フラグを立てFALSEを代入
     i = 0 'カウンタの初期化
     Do Until saveflag = True 'フラグがFALSEの間はループする
      i = i + 1 'カウントアップ
      mysavepath = myfol & "\" & strdate & "_" & Format(i, "00") & ".pdf" '保存パスの再指定
      If Dir(mysavepath) <> "" Then ' 保存パスが存在したら
         saveflag = False 'フラグをFALSEにする
      Else '保存パスが存在しなかったら
         saveflag = True 'フラグをTRUEにする/ループを抜ける
      End If
     Loop 'ループ
  End If
  'PDF保存実行
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mysavepath, Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
（OK） 2020/08/31(月) 18:35

 >もしくは、上書きしますか？と表示が出てファイル名が変更出来たり、

 これは PDF_2の応用で行けます。

Sub PDF_3()

 Dim myfol As String
 Dim karistrname As String
 Dim strname As String
 Dim iptmsg As String
 Dim iptname As String
 Dim mysavepath As String
 Dim saveflag As Boolean
 'myfol = "\\保存先" '保存先フォルダ
  karistrname = Format(Date, "yyyymmdd") '日付
  mysavepath = myfol & "\" & karistrname & ".pdf" '保存パス
  If Dir(mysavepath) <> "" Then '保存パスが存在したら
     iptname = karistrname
     iptmsg = iptname & "は存在します。他の名前を指定してください。"
     saveflag = False 'フラグを立てFALSEを代入
     Do Until saveflag = True 'フラグがFALSEの間はループする
      strname = Application.InputBox(prompt:=iptmsg, Default:=karistrname, Type:=2)
      If strname = "" Then
         MsgBox "ブランクにより中止。"
         Exit Sub
      ElseIf strname = "False" Then
         MsgBox "×かキャンセルにより中止。"
         Exit Sub
      Else
         '続行
      End If
      mysavepath = myfol & "\" & strname & ".pdf" '保存パスの再指定
      If Dir(mysavepath) <> "" Then ' 保存パスが存在したら
         saveflag = False 'フラグをFALSEにする
         iptname = iptname & "/" & strname
         iptmsg = iptname & "は存在します。他の名前を指定してください。"
      Else '保存パスが存在しなかったら
         saveflag = True 'フラグをTRUEにする/ループを抜ける
      End If
     Loop 'ループ
  Else
      mysavepath = myfol & "\" & karistrname & ".pdf" '保存パスの決定
  End If
  'PDF保存実行
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mysavepath, Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
（OK） 2020/08/31(月) 19:56

 またもや修正。

 > 'myfol = "\\保存先" '保存先フォルダ

 ↓に修正してください。

  myfol = "\\保存先" '保存先フォルダ

（OK） 2020/08/31(月) 19:58

OK様

大変丁寧な説明で、2パターンもありがとうございます。

ファイル名があるかどうかをみて、あったらこうする、無かったらこうする…if関数のようですね。
ちょっと初心者には難しかったので、少しずついじってみたり、調べたりして勉強させていただきます。

とても分かりやすく丁寧にお答えいただき、ありがとうございました！

（96） 2020/09/01(火) 14:09

コメント返信：

[ 一覧(最新更新順) ]

[[20200829163928]] 『自動保存で上書きされないようにしたい』（96） ページの最後に飛ぶ

[[20200829163928]]　『自動保存で上書きされないようにしたい』（96）　ページの最後に飛ぶ