Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : 指定なし)
指定したフォルダに同じ名前のファイル存在を確認して処理したい
投稿日時: 21/02/09 23:29:18
投稿者: hahahaaki

指定したフォルダに同じ名前のファイル存在を確認して、なければ保存、あればメッセージを表示したいのですが、ファイルがあるのに進んでしまいます。
ステップをしているのですが、なぜ機能しないのか迷宮に ご指導お願いできれば
  
シートが3つあるうちのシート2のd列4行目から項目があり、この項目の名前でシート3をブックにしたいのです。
  
sub test()
    Dim wsh As Object
    Dim dt_path As String
    Dim bk_name As String
    Dim msg As String
  
'保存するフォルダ指定
   With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "*** フォルダを選択し、[OK]をクリック ***"
    If .Show = True Then
    folder = .SelectedItems(1)
Else
Exit Sub
End If
  
'数確認
    Worksheets(2).Select
    Ls = Cells(Rows.Count, 4).End(xlUp).Row
    For i = 4 To Ls
  
    Set wsh = CreateObject("WScript.Shell")
    dt_path = wsh.SpecialFolders("folder")
    Set wsh = Nothing
  
'ファイル名
   bk_name = "別紙" & Sheets(2).Cells(i, 4)
   bk_name = dt_path & bk_name
  
'同一名のファイルの確認
    If Dir(bk_name) <> "" Then
    msg = "同じ名前のブックが存在します。上書きしますか?"
    If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub
End If
    Sheets(3).Copy
    ActiveWorkbook.SaveAs Filename:=folder & "\" & "別紙" & bk_name
    ActiveWorkbook.Close
    Next i
End With
    MsgBox "終了"
End Sub

回答
投稿日時: 21/02/10 06:09:59
投稿者: simple

引用:
ファイルがあるのに進んでしまいます。
ということであれば、
If Dir(bk_name) <> "" Then
が想定どおりに機能していないことが考えられますね。
>ステップをして
何を確認されていますか?
 
例えば、コードを二行追加して、
Debug.Print bk_name             ' ここを追加
Debug.Print Dir(bk_name)        ' ここを追加
If Dir(bk_name) <> "" Then
イミディエイトウインドウに表示される結果が、
想定と同じなのかどうか検討するというのが、普通の発想だと思います。
 
実行して、結果をお知らせください。
 
併せて、
    Set wsh = CreateObject("WScript.Shell")
    dt_path = wsh.SpecialFolders("folder")
    Set wsh = Nothing
このコードの意図も教えてください。
 
なお、
インデントを正確につけてください。他人のためでなく、あなたのためにです。
変数は必ず宣言するようにしたほうがよいですよ。
    Option Explicit
    をモジュールの一行目に挿入するようにして下さい。
    そうすれば、今回のような未宣言の変数には警告が出て、
    しかも場所を特定してくれますから、原因が直ぐに判明します。
    http://officetanaka.net/excel/vba/beginner/06.htm
 
    ツール − オプション − 編集 で
    「変数の宣言を強制する」にチェックを入れてください。
    モジュールを作成した時点で、Option Explicitが自動的に挿入されるので、
    手間が省けます。
    生涯で一度だけチェックを入れておきさえすればOKで、
    以後、気にする必要はありません。

投稿日時: 21/02/10 10:32:10
投稿者: hahahaaki

simpl 様
  
 いつもご指導ありがとうございます<m(__)m>
  
If Dir(bk_name) <> "" Thenが想定どおりに機能していないことが考えられますね。
  
  はい、私も機能していないと思っていますが原因が迷宮と
  
何を確認されていますか?
  ローカルウインドウで値をみていました
  
  
例えば、コードを二行追加して、
 Debug.Print bk_name ' ここを追加
 Debug.Print Dir(bk_name) ' ここを追加
 If Dir(bk_name) <> "" Then
イミディエイトウインドウに表示される結果が、
想定と同じなのかどうか検討するというのが、普通の発想だと思います。
実行して、結果をお知らせください。
  
 この様な方法があるのですね、Dir・・・
 結果としては、
 Debug.Print bk_name ' ここを追加
   付けたいファイル名が表示されます
 Debug.Print Dir(bk_name) ' ここを追加
   何も表示されません
  
併せて、
  Set wsh = CreateObject("WScript.Shell")
    dt_path = wsh.SpecialFolders("folder")
    Set wsh = Nothing このコードの意図も教えてください。
 
 https://www.relief.jp/docs/excel-vba-save-same-file-name-confirmation.html
 のサイトを参考にしていたので、単純にコピペしていました すみません
  
なお、
●インデントを正確につけてください。他人のためでなく、あなたのためにです。
  
 すみません。インデントの付け方がよくわからず、調べて勉強してみます
  
●変数は必ず宣言するようにしたほうがよいですよ。
    Option Explicit
    をモジュールの一行目に挿入するようにして下さい。
    そうすれば、今回のような未宣言の変数には警告が出て、
    しかも場所を特定してくれますから、原因が直ぐに判明します。
    http://officetanaka.net/excel/vba/beginner/06.htm
    ツール − オプション − 編集 で
    「変数の宣言を強制する」にチェックを入れてください。
    モジュールを作成した時点で、Option Explicitが自動的に挿入されるので、
    手間が省けます。
    生涯で一度だけチェックを入れておきさえすればOKで、
    以後、気にする必要はありません。
  
 勉強になります。
 早速設定しました。ありがとうございます
 

回答
投稿日時: 21/02/10 11:06:21
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

If Dir(bk_name) <> "" Thenが想定どおりに機能していないことが考えられますね。
  はい、私も機能していないと思っていますが原因が迷宮と

機能していない理由は、↓の指定との整合にあると思いますが・・・・
> ActiveWorkbook.SaveAs Filename:=folder & "\" & "別紙" & bk_name
 
↑の保存場所の指定は、正しいのかな?

回答
投稿日時: 21/02/10 11:16:34
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

  Set wsh = CreateObject("WScript.Shell")
     dt_path = wsh.SpecialFolders("folder")
     Set wsh = Nothing このコードの意図も教えてください。

このコードは、他のページからコピペしたは、どうでもよいが、
意図した結果になっているかを確認することが重要です。
 

投稿日時: 21/02/10 12:49:13
投稿者: hahahaaki

皆様ありがとうございます
 
まだまだ勉強中ですが、
Dirでのファイル名取得のところかと思っています。
 
最初に保存先を選んでいるのですが・・うまく活用できていない
保存先についても、ご指摘のとおりで 何度か変更して保存はうまくいくのですが、
 
同一ファイル名があるのに Ifでのメッセージがスキップされてしまいで(-_-;)
folder =の箇所
bk_name の箇所 あたりを見直してみます
 
引き続きご指導お願いいたします。 

回答
投稿日時: 21/02/10 15:23:38
投稿者: simple

回答拝見しました。既に頂いている指摘と一部重なりますが、コメントします。
 

引用:
Set wsh = CreateObject("WScript.Shell")
    dt_path = wsh.SpecialFolders("folder")
    Set wsh = Nothing
このコードの意図も教えてください。

普通は"desktop"や"MyDocuments"といった特殊フォルダを得る場合に使うものです。
"folder"などという引数はありません。
どんな特殊フォルダを指定したかったかは、説明がないとわかりませんよ。
だから、意図を書いて下さい、と言ったのです。結果以前の話です。
 
引用:
 Debug.Print bk_name ' ここを追加
   付けたいファイル名が表示されます
 Debug.Print Dir(bk_name) ' ここを追加
   何も表示されません
とのこと。
 
Dir関数のヘルプに目を通してください。
理解されているようですが、Dir関数に与えるbk_nameは
ドライブ名から始まるフルパスである必要があります。
(フォルダ名までを対象とすることはあります。)
(なお、フォルダを指定せずファイル名だけ指定した場合は、
  カレントフォルダが省略されたものと見なして、内部で補完が行われます。)
 
存在有無を確認したいフォルダの指定(Dir関数の引数部分)が間違っているので、
正しく指定してください。
 
保存先のフォルダを指定していますが、それではないんですか?
それなら既に文字列変数folderにそれが得られているので、それを使えば良いだけです。
dt_pathなどというものは不要です。
(それとは別のものであれば、もうひとつ指定するかですね。)
 
ちなみに、インデントを正確に付ける例です。(内容は変えていません)
Sub test()
    Dim wsh As Object
    Dim dt_path As String
    Dim bk_name As String
    Dim msg As String

    '保存するフォルダ指定
    With Application.FileDialog(msoFileDialogFolderPicker)
        .title = "*** フォルダを選択し、[OK]をクリック ***"
        If .Show = True Then
            Folder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With    'Withは、必要範囲で出来るだけ狭い範囲に限定すべき。

    Worksheets(2).Select
    Ls = Cells(Rows.Count, 4).End(xlUp).Row
    For i = 4 To Ls

        Set wsh = CreateObject("WScript.Shell")
        dt_path = wsh.SpecialFolders("folder")
        Set wsh = Nothing

        'ファイル名
        bk_name = "別紙" & Sheets(2).Cells(i, 4)
        bk_name = dt_path & bk_name

        '同一名のファイルの確認
        Debug.Print bk_name     ' ■■■■■■■■■■
        If Dir(bk_name) <> "" Then
            msg = "同じ名前のブックが存在します。上書きしますか?"
            If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub
        End If
        Sheets(3).Copy
        ActiveWorkbook.SaveAs Filename:=Folder & "\" & "別紙" & bk_name
        ActiveWorkbook.Close
    Next i
    
    MsgBox "終了"
End Sub

回答
投稿日時: 21/02/10 15:29:14
投稿者: simple

folder変数とファイル名を連結するときに、"\"を挟むことを忘れないようにしてください。

回答
投稿日時: 21/02/10 15:52:49
投稿者: WinArrow
投稿者のウェブサイトに移動

ついでだから、レスしておきます。
 
 

引用:

問題個所1
    Set wsh = CreateObject("WScript.Shell")
    dt_path = wsh.SpecialFolders("folder")
    Set wsh = Nothing

引用:

問題個所2
 
        'ファイル名
        bk_name = "別紙" & Sheets(2).Cells(i, 4)
        bk_name = dt_path & bk_name

 
問題個所1の「dt_path」を問題個所2で使用してますね・・・・
問題個所1で「dt_path」にどのような値が入っているか
確認してみましょう。
そうすれば、原因がわかると思いますよ。

投稿日時: 21/02/10 16:41:51
投稿者: hahahaaki

皆様 ご指導ありがとうございます
 
    Set wsh = CreateObject("WScript.Shell")
    dt_path = wsh.SpecialFolders("folder")
    Set wsh = Nothing
については、調べました。
ご指導のとおり、特殊フォルダなのですね
単純にfolderにすれば良いと考えていました。すみません。
 
pathのところも、コピペではなく、既に取得しているfolderで事足ります。
不要のため削除しました。
 
インデントも処理がわかるように記載したほうが見やすいし、エラーの時にも
よくわかります。
ご指導ありがとうございます。
 
いまいち、理解しきれていませんが、Dirのところも判定してくれるようになりました
 
もう少し勉強し大丈夫そうであれば閉じたいと思います。
しばし、お時間をいただき 引き続きお付き合いいただけると幸いです

投稿日時: 21/02/10 17:20:24
投稿者: hahahaaki

無事に思うようになり、ご指導いただいた内容を勉強しました
コピペしても内容を理解しなければならないことを改めて思いました
 
わかったつもりでは駄目ですね
ありがとうございました