回答編集履歴
1
処理修正
answer
CHANGED
@@ -67,22 +67,14 @@
|
|
67
67
|
ado.Fields.Append "FILENAME", 200, 300, 32 ' ファイル名
|
68
68
|
ado.Open
|
69
69
|
|
70
|
-
Dim OutPutFile As Boolean
|
71
70
|
' GetFolderでパスを取得しAdoに格納
|
71
|
+
Dim file As Object
|
72
72
|
For Each file In Fso.GetFolder(strPathName).Files
|
73
|
-
|
74
|
-
'
|
73
|
+
' 登録ファイルチェック
|
75
|
-
OutPutFile = True
|
76
|
-
For i = 0 To ListBox1.ListCount - 1
|
77
|
-
If Dir(file) Like ("*" & ListBox1.List(i) & "*") Then
|
78
|
-
OutPutFile = Fasle ' 除外ファイル名が含まれていた場合は登録フラグOFF
|
79
|
-
Exit For
|
80
|
-
End If
|
81
|
-
Next
|
82
|
-
If
|
74
|
+
If IsOutPutFile(file) Then
|
83
|
-
ado.AddNew
|
84
75
|
' ファイル名は以下の形式
|
85
76
|
' (番号)_(○○○)_(×××).xls
|
77
|
+
ado.AddNew
|
86
78
|
ado.Fields(0) = padZero(CInt(Split(Dir(file), "_")(0)), 4) ' 番号(0埋)
|
87
79
|
ado.Fields(1) = file ' フルPATH
|
88
80
|
ado.Update
|
@@ -101,6 +93,7 @@
|
|
101
93
|
xlApp.Workbooks.Close ' Excelを閉じる
|
102
94
|
xlApp.DisplayAlerts = True
|
103
95
|
End If
|
96
|
+
If Not Fso Is Nothing Then Set Fso = Nothing
|
104
97
|
If Not ado Is Nothing Then Set ado = Nothing
|
105
98
|
If Not xlApp Is Nothing Then Set xlApp = Nothing
|
106
99
|
MsgBox "処理を中断しました。", vbInformation, "処理中断"
|
@@ -123,6 +116,7 @@
|
|
123
116
|
MsgBox "印刷ジョブに登録しました。", vbInformation, "処理終了"
|
124
117
|
Exit Sub
|
125
118
|
ErrorHandler:
|
119
|
+
If Not Fso Is Nothing Then Set Fso = Nothing
|
126
120
|
If Not ado Is Nothing Then Set ado = Nothing
|
127
121
|
If Not xlApp Is Nothing Then Set xlApp = Nothing
|
128
122
|
MsgBox Err.Number & ":" & Err.Description, vbCritical & vbOKOnly, "例外発生"
|
@@ -190,7 +184,7 @@
|
|
190
184
|
End Function
|
191
185
|
|
192
186
|
'''
|
193
|
-
''' 除外
|
187
|
+
''' 除外ファイル名登録
|
194
188
|
'''
|
195
189
|
Private Sub SetListData()
|
196
190
|
Worksheets(2).Columns("A").Delete
|
@@ -200,5 +194,17 @@
|
|
200
194
|
ThisWorkbook.Save
|
201
195
|
End Sub
|
202
196
|
|
197
|
+
'''
|
198
|
+
''' 登録ファイルチェック
|
199
|
+
'''
|
200
|
+
Private Function IsOutPutFile(file As Object) As Boolean
|
201
|
+
IsOutPutFile = True
|
202
|
+
For i = 0 To ListBox1.ListCount - 1
|
203
|
+
If Dir(file) Like ("*" & ListBox1.List(i) & "*") Then
|
204
|
+
IsOutPutFile = False ' 除外ファイル名が含まれていた場合は登録フラグOFF
|
205
|
+
Exit For
|
206
|
+
End If
|
207
|
+
Next
|
208
|
+
End Function
|
203
209
|
|
204
210
|
```
|