[[20201116151400]]　『保存先に同名のファイルがあれば番号を付けて保存』（hswa）　ページの最後に飛ぶ

『保存先に同名のファイルがあれば番号を付けて保存。』（hswa）

  source_dir = Range("L5").Value & "\" & Cells(kkk, 11).Value & "\"
  dist_dir = Range("L6").Value & "\" & Cells(kkk, 11).Value & "\"

  If Dir(source_dir, vbDirectory) = "" Then
    MsgBox "リネーム前ファイルパス がみつかりません"
 Exit Sub
  End If

  If Dir(dist_dir, vbDirectory) = "" Then
    MsgBox "親フォルダ保存先パス がみつかりません"
Exit Sub
  End If

    i = 2
  Do While Cells(i, 1).Value <> ""
    source_filename = source_dir & Cells(i, 3).Value

    If Dir(source_filename) = "" Then 
       Cells(i, 3).Interior.Color = RGB(255, 0, 0) 
       dist_name = Cells(i, 5) & ".pdf"
       dist_dir1 = Cells(i, 4)
       dist_dir2 = Cells(i, 8)

       dist_path1 = dist_dir & "\" & dist_dir1
    If Dir(dist_path1, vbDirectory) = "" Then 
         MkDir (dist_path1)
    End If

       dist_path2 = dist_path1 & "\" & dist_dir2
    If Dir(dist_path2, vbDirectory) = "" Then 
         MkDir (dist_path2)
    End If

       dist_filename = dist_path2 & "\" & dist_name
       If Dir(dist_filename) <> "" Then         
           Cells(i, 3).Interior.Color = RGB(0, 256, 0)  
    Else
           Name source_filename As dist_filename 
           Cells(i, 3).Interior.Color = RGB(0, 0, 200)
    End If

    End If

    i = i + 1
  Loop

現在上記のマクロを使用しているのですが、（構文の途中で）
このマクロの処理に、保存先にもし同名ファイルがあった場合、-2、-3と表記させる方法をご教示いただけますと幸いです。

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

 マクロの事は良くわかりませんが11/13に似たようなものがあるので
 参考になりますでしょうか
（なるへそ） 2020/11/16(月) 15:32

 書いてみました。

    Function newSaveName(FullFilePath As String) As String
      Dim FSO As Object
      Dim Path As String, ext As String

      Set FSO = CreateObject("Scripting.FileSystemObject")
      FullFilePath = FSO.GetAbsolutePathName(FullFilePath)
      Path = FSO.GetParentFolderName(FullFilePath) & "\" & FSO.GetBaseName(FullFilePath)
      ext = "." & FSO.GetExtensionName(FullFilePath)

      newSaveName = Path & ext
      i = -1
      Do While FSO.Fileexists(newSaveName)
         newSaveName = Path & i & ext
         i = i - 1
      Loop
      Set FSO = Nothing
    End Function
（´・ω・`） 2020/11/16(月) 16:10

ありがとうございます！具体的にどの部分に追記すればよろしいでしょうか、、？
（hswa） 2020/11/16(月) 17:19

 >-2、-3と表記
 どこに表記するんですか？

 今のコードでは、同盟ファイルがある場合は、
　Cells(i, 3).Interior.Color = RGB(0, 256, 0) 
 して、何もせずに次の動作にいきますが、

 ファイル名に枝番をつけて、移動するなら、どんなファイル名に変更したか
 記録を残さないと後で分からなくなりますね
 その記録をどこのセルにいれますか？

 とりあえず、こうすればいいのですが、

 修正前 dist_filename = dist_path2 & "\" & dist_name
 修正後 dist_filename = newSaveName( dist_path2 & "\" & dist_name )
（´・ω・`） 2020/11/16(月) 20:38

コメント返信：

[ 一覧(最新更新順) ]

[[20201116151400]] 『保存先に同名のファイルがあれば番号を付けて保存』（hswa） ページの最後に飛ぶ

[[20201116151400]]　『保存先に同名のファイルがあれば番号を付けて保存』（hswa）　ページの最後に飛ぶ