【Excel2010 VBA】同名ファイルチェック

質問

医療系マクロを作っています。下記はUserForm3上のCommandButton2をクリックすると特定の場所にある原本1.xlsmをUserForm3.TextBox13(患者名)にリネームして特定の場所へコピーするマクロです。

Private Sub CommandButton2_Click()
Dim cnsSOUR2 As String, cnsORSL As String, cns2FSO2 As String, cns4FSO2 As String
cnsORSL = ThisWorkbook.Path & "\..\メンテナンスフォルダ\インストールフォルダ\原本1.xlsm"
cnsSOUR2 = ThisWorkbook.Path & "\看護情報フォルダ\" & UserForm3.TextBox13 & ".xlsm"
cns2FSO2 = ThisWorkbook.Path & "\..\2Fカーデックス\看護情報フォルダ\" &　UserForm3.TextBox13 & ".xlsm"
cns4FSO2 = ThisWorkbook.Path & "\..\4Fカーデックス\看護情報フォルダ\" & UserForm3.TextBox13 & ".xlsm"

FileCopy cnsORSL, cnsSOUR2　'　ここでリネーム&移動
End Sub

しかし移動先に同名ファイルが存在する場合にエラーが出てしまいます。そこで
If Dir(cnsSOUR2) <> "" Then
If Dir(cns2FSO2) <> "" Then
If Dir(cns4FSO2) <> "" Then
などで同名が存在してることが分かった場合、UserForm3.TextBox13(患者名)の語尾に2とつけて、
上記も同名が存在してることが分かった場合、UserForm3.TextBox13(患者名)の語尾に3とつけて…
を99まで繰り返したいです。※(転棟の都合により)cnsSOUR2、cns2FSO2、cns4FSO2の複数の場所で同名ファイルチェックが必要になります。

難解のため、断念いたしました。お手数ですが何卒よろしくお願いします。

回答No.1

keithin · ベストアンサー

Private Sub CommandButton2_Click()
　Dim cnsSOUR2 As String, cnsORSL As String, cns2FSO2 As String, cns4FSO2 As String
　dim s as string

　cnsORSL = ThisWorkbook.Path & "\..\メンテナンスフォルダ\インストールフォルダ\原本1.xlsm"

　s = ""
　do until dir(ThisWorkbook.Path & "\看護情報フォルダ\" & UserForm3.TextBox13 & s & ".xlsm") = ""
　　s = val(s) + 1
　loop
　cnsSOUR2 = ThisWorkbook.Path & "\看護情報フォルダ\" & UserForm3.TextBox13 & s & ".xlsm"
　cns2FSO2 = ThisWorkbook.Path & "\..\2Fカーデックス\看護情報フォルダ\" &　UserForm3.TextBox13 & s & ".xlsm"
　cns4FSO2 = ThisWorkbook.Path & "\..\4Fカーデックス\看護情報フォルダ\" & UserForm3.TextBox13 & s & ".xlsm"

　FileCopy cnsORSL, cnsSOUR2　'　ここでリネーム&移動
End Sub
みたいな。

お礼

上記参考させてもらい別の方法で乗り切りました。アドバイスありがとうございました！