マクロの同じファイル名が存在する場合について

こんにちわ
マクロ（VBA）でかいています
実行してExcelファイルを開きそのなかから特定のものを抽出し、csvファイルで出力するものです。
エクセルファイルはシートが複数あり、シートごとに条件によって特定の文字を抽出させています

vba
1Sub Run()
2    Dim OpenFileName As String    
3    Dim wb As Workbook
4    
5    'ファイルを開くダイアログ
6    OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
7    If OpenFileName = "False" Then
8        Exit Sub
9    End If
10  
11    Set wb = Workbooks.Open(OpenFileName)
12   
13    ' ブックの全シートを 1 つずつループして処理する
14    For Each ws In wb.Worksheets
15    
16        Dim maxCol, maxRow As Integer
17        maxCol = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column
18        maxRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
19        For i = 10 To maxRow Step 4
20                   
21            '----T----
22            '改行とスペースを削除
23            Dim Tcode As String
24            Tcode = Replace(ws.Cells(i, 1).Value, vbCrLf, "")
25            '----K----
26            Dim Kcode As String
27            Kcode = ws.Cells(i, 3).Value
28            
29            '----J----
30            Dim Jcode As String
31            Jcode = ws.Cells(i + 2, 2).Value
32                                
33            '----ナンバー----
34            Dim Number String
35                                
36        If maxCol = 20 Then
37              
38            '----ナンバー----
39            Number = ws.Cells(i, 19).Value
40            
41        ElseIf maxCol = 30 Then
42            
43            '----ナンバー----
44            Number = ws.Cells(i, 19).Value
45           
46        Else
47            
48            '----ナンバー----
49            Number= ws.Cells(i, 20).Value
50           
51            End If
52
53             Dim nameFile As String
54             Dim Filenum As Long
55             Dim msg As String
56                    
57             nameFile = Format(Now(), "yyyymmdd") & ".csv"
58             nameFile = ActiveWorkbook.Path & "\" & nameFile
59             
60             
61             Filenum = FreeFile()
62             Open nameFile For Append As #Filenum
63             Print #Filenum, Tcode + "," + Kcode + "," + Jcode + "," + Number
64             Close #Filenum
65             
66             '同じファイル名があるとき警告
67             If Dir(nameFile & ".csv") <> "" Then
68                msg = "同じ名前のファイルが存在します。上書きしますか?"
69                If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub               
70             End If
71             
72             Application.DisplayAlerts = False
73             ActiveWorkbook.SaveAs Filename:=nameFile
74                            
75        Workbooks.Close
76        
77        Next
78
79    Next
80         MsgBox "処理が完了しました"
81
82End Sub

うまくできないのが、同じ名前のcsvファイルが存在するときに
上書きしますか？といった警告をだして、はいを選べば上書き、いいえを選べばキャンセルで処理を行わないといったことをしたいのですが
現状同じファイル名がなくても警告がでてしまい、また保存をするとなぜか最初に開くもとのファイルが出力されてしまいます
ファイル名は実行した段階の日付になるようにしています
'同じファイル名があるとき警告～の部分がなければきちんと希望の形でcsvファイルに出力されるのですが…

また最後に最初に開いたエクセルファイルは処理が終わるとともに閉じたいのですがうまくいきません
Workbooks.Closeですべて閉じれると思っているのですが違うのでしょうか？

すみませんが、アドバイスお願いいたします

追記
無事解決いたしました！
お助けいただきありがとうございました。

行動規範の内容に同意します

回答1件

ベストアンサー

わからないこと。

シートをCSVで書き出す前に、Open,Print,Closeの処理があります。
このCSVファイルと、シートのCSVファイルのファイル名が同じに見えるのですが、そういう仕様でしょうか？

VBA
1' ここのファイル名と
2nameFile = Format(Now(), "yyyymmdd") & ".csv"
3nameFile = ActiveWorkbook.Path & "\" & nameFile
4Filenum = FreeFile()
5Open nameFile For Append As #Filenum
6
7～
8' ここのファイル名は一緒
9ActiveWorkbook.SaveAs Filename:=nameFile

またシート内を1行するたびに上記のOpenで作成する処理とシートをCSVに書き出す処理が動きますが、そういう仕様でしょうか？

Dirで同じファイルが存在するかを確認する際に、".csv"を付加しているのは仕様でしょうか？
パス\20180417.csv.csvのような形式になっています。
逆に".csv"の付加が間違っている場合、前述のOpen,Print,Closeでファイルを作成しているので、当然ですが毎回「同じ名前のファイルが存在します」に該当してしまいます。

修正しないといけないところ。

CSVで書き出すときはアクティブなシートのみが対象となります。
なので、シートのループ内で対象シートをアクティブ化しないといけません。

VBA
1For Each ws In wb.Worksheets
2	ws.Activate              ' シートをアクティブ化

CSVで書き出す場合、ファイルフォーマットを指定しないと元のExcel形式のまま出力されるかもしれません。
使っているのが古いタイプのxlsファイルのようなので大丈夫なのかもしれませんが、念のためSaveAsの引数FileFormatを指定したほうがよいかもしれません。

VBA
1ActiveWorkbook.SaveAs Filename:=nameFile, FileFormat:=xlCSV

Workbooks.Closeですべて閉じれると思っているのですが違うのでしょうか？

可能だと思いますが、実行する場所が正しくないです。
現状シートのループ内で行っているので1シートおよび1行処理するだけで全ブックを閉じようとしてしまいます。
実行する場所は「処理が終了しました」コメントの前でよいかと。
但し自分自身も閉じてしまうかもしれないので、残しておきたい（最初に開いたブックのみを閉じたい）のであれば、

VBA
1wb.Close

で良いと思います。

修正案です。

VBA
1Sub Run()
2	Dim OpenFileName As String    
3	Dim wb As Workbook
4
5	'ファイルを開くダイアログ
6	OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
7	If OpenFileName = "False" Then
8		Exit Sub
9	End If
10
11	Set wb = Workbooks.Open(OpenFileName)
12
13	Dim nameFile As String
14	Dim Filenum As Long
15	Dim msg As String
16
17	nameFile = Format(Now(), "yyyymmdd") & ".csv"
18	nameFile = ActiveWorkbook.Path & "\" & nameFile
19
20	'同じファイル名があるとき警告
21	If Dir(nameFile) <> "" Then
22		msg = "同じ名前のファイルが存在します。上書きしますか?"
23		If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub               
24	End If
25
26	Filenum = FreeFile()
27	Open nameFile For Append As #Filenum
28
29	' ブックの全シートを 1 つずつループして処理する
30	For Each ws In wb.Worksheets
31
32		Dim maxCol, maxRow As Integer
33		maxCol = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column
34		maxRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
35		For i = 10 To maxRow Step 4
36
37			'----T----
38			'改行とスペースを削除
39			Dim Tcode As String
40			Tcode = Replace(ws.Cells(i, 1).Value, vbCrLf, "")
41			'----K----
42			Dim Kcode As String
43			Kcode = ws.Cells(i, 3).Value
44
45			'----J----
46			Dim Jcode As String
47			Jcode = ws.Cells(i + 2, 2).Value
48
49			'----ナンバー----
50			Dim Number String
51
52			If maxCol = 20 Then
53
54				'----ナンバー----
55				Number = ws.Cells(i, 19).Value
56
57			ElseIf maxCol = 30 Then
58
59				'----ナンバー----
60				Number = ws.Cells(i, 19).Value
61
62			Else
63
64				'----ナンバー----
65				Number= ws.Cells(i, 20).Value
66
67			End If
68
69			Print #Filenum, Tcode + "," + Kcode + "," + Jcode + "," + Number
70		Next
71
72	Next
73
74	Close #Filenum
75	wb.Close
76
77	MsgBox "処理が完了しました"
78
79End Sub
80

投稿2018/04/17 04:39

編集2018/04/17 06:23

ttyp03

総合スコア16998

pro-poke5

2018/04/17 05:14

回答ありがとうございます出力されるCSVファイルは今日の日付で保存しようとして、その際に同じ名前のものがないかチェックするためどちらもnameFileという引数?でかいていますが場所がおかしいのでしょうか…？またシート内を1行するたびに上記のOpenで作成する処理とシートをCSVに書き出す処理が動くのは仕様です Dirで同じファイルが存在するかを確認する際に、".csv"を付加しているのは同じ名前で.txtなどがあった場合を考慮してでしたが不要ということですね

ttyp03

2018/04/17 05:26

なんかうまく伝わっていないような…。 Tcodeなどを出力しているCSVファイルと、シート丸ごとCSVファイルとして出力しているファイルは同じファイルを想定していますか？もしかしてTcodeなどを出力したあとに、シート丸ごとを「追記」しようとしています？＞不要ということですね同名ファイルがあるかないかを調べたいのであれば不要ですね。ただその前に回答にも書きましたが、自分で先にファイル作っちゃってるので、必ず同名ファイルがありますよ。チェック場所の問題だけと思いますが。

pro-poke5

2018/04/17 05:45

出力しようとしているファイルはTcodeなどがある最初に開いたファイルから抽出したもののみのつもりですが、このコードではシートをまるごと出力もしているのでしょうか…?

ttyp03

2018/04/17 05:48

ActiveWorkbook.SaveAsってやってますよね。これでアクティブなブックのアクティブなシートをCSVファイルとして保存しています。なんとなく仕様がわかったので、回答に修正案を書いてみますね。

ttyp03

2018/04/17 05:49

一点不明点が。ブック内の各シートに対して同じCSVファイル名になってしまいますが、これはこのままでいいんでしょうか？それとも同じファイルに追記するのでしょうか？たぶんこれですね。

ttyp03

2018/04/17 05:53

追記しましたのでご確認ください。動作は未検証です。

pro-poke5

2018/04/17 05:54

回答ありがとうございます色々調べながらかいていったら余分なものまでかいていたようですね… 各シートの値は同じCSVファイルにまとめて出力させたいのでExcelのシートごとにファイルを分けたりなにか区別させる必要はありません

pro-poke5

2018/04/17 06:18

修正案ありがとうございますひとまず書いてみたのですが、オブジェクト変数または With ブロック変数が設定されていませんというエラーでうまくできません nameFileにSetをつけるべきかとも思ったのですがそういうわけではないみたく…何が原因でしょうか…？

ttyp03

2018/04/17 06:25

ブックをOpenする場所が悪かったですね。修正してみましたが、これで直るかな…。ひとまず試してみてください。

jawa

2018/04/17 06:37

横から失礼します。自分でも回答用意していたのですが、ttyp03さんの回答とやりとりでほぼ同じ内容が指摘されており、解決までたどり着きそうでしたので。私のほうで気になっている点がひとつあります。ファイル存在チェックの内容が「上書きしますか？」の確認なのですが、Openの際にFor Appendとしているので追記モードになっていると思います。追記でよければこれでいいのですが、今回内容だけのファイルとして上書きしたいのならFor Outputのほうがよいかもしれません。

ttyp03

2018/04/17 06:39

＞jawaさんそこ見逃してました。指摘助かります。

pro-poke5

2018/04/17 06:43

お二人とも回答ありがとうございます回答ありがとうございますひとまずうまくいきました！ありがとうございます…！ただ上書きするかの警告で、はいを押すと最初に開いたブックは閉じるのですがいいえを選択すると開いたままになってしまっています警告のifぶんのなかでかく必要があるのでしょうか? まとめてかくことはできないのでしょうか？

ttyp03

2018/04/17 06:49

手っ取り早いのはif文の中でCloseでしょうか。 If MsgBox(msg, vbYesNo) = vbNo Then wb.Close Exit Sub End if まとめて書きたい場合、終了処理をラベルで用意して、Gotoで飛ばすなどが考えられますが、ファイルがオープンしていたら閉じるなどの判定処理も必要になってきますので、意外と面倒です。今回の場合は（ひとまず）if文内の処理で良いかと思いますが、状況に応じ処理を拡張してください。

行動規範の内容に同意します