PDF連続保存

投稿者 : こはる     投稿日時 : 2022/08/30(Tue) 15:44:11     OS : 未指定     EXCEL : 未指定

---

PDF保存をする際に、同じフォルダ名があると上書き保存されてしまいます。
同じファイルがある場合、～(1).pdfと、連番で保存していきたいです。

デスクトップに保存までのVBAは書けましたが、連番がどうにもうまくいきません。
ほかのサイトを参考にしてここまで書いています。

ご助言いただけますでしょうか？




'名前をつけて保存
Dim Desktop_Path As String
Desktop_Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")
With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Desktop_Path & "\" & "" & .Range("AI1").Value & ".pdf"
End With
'''保存しようとしたファイル名と既に同じファイル名が存在するならば、
'''ファイル名の末尾に(i)をつける
If Dir(fileSaveName) <> "" Then
'保存ファイル名を取得
fileSaveName_name = Dir(fileSaveName)
'保存先のフォルダを取得
fileSaveName_path = Replace(fileSaveName, fileSaveName_name, "")

'保存ファイル名の末尾に(i)をつける
k = 1
Do While Dir(fileSaveName) <> ""
fileSaveName = fileSaveName_path & Replace(fileSaveName_name, ".pdf", "") & "(" & k & ")" & ".pdf"
k = k + 1
Loop
End If

投稿者 : さんこう     投稿日時 : 2022/08/30(Tue) 16:43:37

---

＞PDF保存をする際に、同じフォルダ名があると上書き保存されてしまいます。

お示しのコードでは、保存してから
「保存しようとしたファイル名と既に同じファイル名が存在するならば、ファイル名の末尾に(i)をつける」
をしようとしていますので、上書保存されて当然です。

保存前に同じファイル名があるか確認しましょう。


下記は、同じファイル名があれば「(1)」をつけるコードのサンプルです。
参考になれば。

Sub FileNameTest()
    Dim Desktop_Path As String
    Dim fileSaveName As String
    Dim k As Long
    
    With ActiveSheet
        Desktop_Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")
        k = 0
        Do
            fileSaveName = Desktop_Path & "\" & .Range("AI1").Value & IIf(k = 0, "", "(" & k & ")") & ".pdf"
            k = k + 1
        Loop While Dir(fileSaveName) <> ""
    End With
    MsgBox fileSaveName
End Sub

投稿者 : OK     投稿日時 : 2022/09/01(Thu) 08:12:40

---

回答者への参考として。

http://www.vbalab.sakura.ne.jp/vbaqa/c-board.cgi?cmd=ntr;tree=82054;id=excel


他のサイトでも書きましたが、また、さんこうさんがご指摘していますが、PDFファイル
を作成した後ファイル名を生成しても意味がありません。
また、サイトのコードを切り貼りしても基本的に動かないと考えたほうがいいです。
コードの意味をよく理解した後、ご自分のコードに組み入れたりコードの修正をする
ように心がけましょう。