teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

処理修正

2015/06/10 05:09

投稿

bbs
bbs

スコア16

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 OutPutFile Then
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
  ```