おおぞらのとんび

↓がコードの続きです。コピペしてください。
（先に『Excel VBA ファイル名順にコピー１』のコードからコピペしてください）


'除外クリック
Private Sub btnListItemDel_Click()
Dim itmLvw As ListItem
Dim i As Long

btnListItemDel.Enabled = False

'リストの後ろの方から、選択されているアイテムを削除
For i = lvwList.ListItems.Count To 1 Step -1
Set itmLvw = lvwList.ListItems(i)
If itmLvw.Selected Then
lvwList.ListItems.Remove itmLvw.Index
End If
Next i

End Sub

'ストップクリック
Private Sub btnCopyStop_Click()
GLB_BLN_STOP = True
End Sub

'コピー実行クリック
Private Sub btnCopyRun_Click()
InitAllCtl (False)

If tbxPathEX = "" Then
MsgBox ("出力先フォルダを入力してください。")
InitAllCtl (True)
Exit Sub
End If

If lvwList.ListItems.Count > 0 Then
'コピー実行
If fncCopyRun = True Then MsgBox ("コピーが終わりました。") Else MsgBox ("コピーを失敗しました")
Else
MsgBox ("処理データがありません")
End If

InitAllCtl (True)


End Sub

'コピー実行
Private Function fncCopyRun() As Boolean
Const CST_YEN = "\"
Dim strFilename As String
Dim strFilePath As String
Dim strFilePathEX As String
Dim i As Long
Dim intMaxListCnt As Integer
Dim intUwagaki As Integer

fncCopyRun = True

On Error GoTo errFnc
GLB_BLN_STOP = False
btnCopyRun.Visible = False
btnCopyStop.Visible = True
lblCopyRun.Visible = True

'チェック
If (Len(tbxPath.Text) = 0) Or (tbxPath.Text = "False") Then Exit Function
strFilePath = tbxPath.Text
If (Len(tbxPathEX.Text) = 0) Or (tbxPathEX.Text = "False") Then Exit Function
strFilePathEX = tbxPathEX.Text

'リスト数
intMaxListCnt = lvwList.ListItems.Count
intUwagaki = 0
'
For i = 1 To intMaxListCnt
lvwList.ListItems(i).Selected = False
Next i

For i = 1 To intMaxListCnt
'lvwList.ListItems(i).Selected = True
DoEvents
lblCopyRun.Caption = "コピー中　" & Str(i) & " / " & Str(intMaxListCnt)
If GLB_BLN_STOP Then
If MsgBox("中止しますか？", vbYesNo) = vbYes Then
Exit For
Else
GLB_BLN_STOP = False
End If
End If
strFilename = lvwList.ListItems(i).Text
'上書き確認
If Dir(strFilePathEX & CST_YEN & strFilename) <> "" Then
If intUwagaki = 0 Then
If MsgBox("「　" & strFilename & "　」は、すでに存在します。上書きしますか？", vbYesNo) = vbYes Then
intUwagaki = 1
'コピー実行
FileCopy strFilePath & CST_YEN & strFilename, strFilePathEX & CST_YEN & strFilename
Else
intUwagaki = -1
End If

If MsgBox("今後すべてに同じ処理をしますか？", vbYesNo) = vbNo Then
intUwagaki = 0
End If
ElseIf intUwagaki = 1 Then
'コピー実行
FileCopy strFilePath & CST_YEN & strFilename, strFilePathEX & CST_YEN & strFilename
End If
Else
'コピー実行
FileCopy strFilePath & CST_YEN & strFilename, strFilePathEX & CST_YEN & strFilename
End If

Next i
lblCopyRun.Caption = "実行中"
GLB_BLN_STOP = False
btnCopyRun.Visible = True
btnCopyStop.Visible = False
lblCopyRun.Visible = False
Exit Function
errFnc:
lblCopyRun.Caption = "実行中"
GLB_BLN_STOP = False
btnCopyRun.Visible = True
btnCopyStop.Visible = False
lblCopyRun.Visible = False

fncCopyRun = False

End Function

'リストビューフォーカスIN
Private Sub lvwList_Click()
If lvwList.ListItems.Count > 0 Then
btnListItemDel.Enabled = True
End If
' If lvwList.SelectedItem.Index > 0 Then
' btnListItemDel.Enabled = True
' End If
End Sub

'フィルタ用のテキストボックス変更イベント
'Private Sub tbxJyouken_Change()
Private Sub tbxJyouken_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If ThisWorkbook.Worksheets(CST_STR_SETTING).Range(CST_STR_SET_CELL2).Value <> tbxJyouken.Text Then
If tbxJyouken.Enabled = True Then subPathChange
ThisWorkbook.Worksheets(CST_STR_SETTING).Range(CST_STR_SET_CELL2).Value = tbxJyouken.Text
End If
End Sub

'コピー元のテキストボックス変更イベント
Private Sub tbxPath_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If ThisWorkbook.Worksheets(CST_STR_SETTING).Range(CST_STR_SET_CELL1).Value <> tbxPath.Text Then
If tbxPath.Enabled = True Then subPathChange
ThisWorkbook.Worksheets(CST_STR_SETTING).Range(CST_STR_SET_CELL1).Value = tbxPath.Text
End If
End Sub

'コピー元ファイル読み込み
Private Sub subPathChange()
Const CST_YEN = "\"
Dim strFilename As String
Dim strFilePath As String
Dim intCntEve As Long

InitAllCtl (False)

lvwList.ListItems.Clear

'チェック
If (Len(tbxPath.Text) = 0) Or (tbxPath.Text = "False") Then
InitAllCtl (True)
Exit Sub
End If
strFilePath = tbxPath.Text

' 指定フォルダ内のファイル名を参照する(1件目)
strFilename = Dir(strFilePath & CST_YEN & "*.*", vbNormal)
If strFilename = "" Then
MsgBox "このフォルダにはファイルは存在しません。"
InitAllCtl (True)
Exit Sub
End If

GLB_BLN_STOP = False
btnCopyRun.Visible = False
btnCopyStop.Visible = True
lblCopyRun.Visible = True

intCntEve = 0
' 指定フォルダの全ファイルについて繰り返す
Do While strFilename <> ""
intCntEve = intCntEve + 1
lblCopyRun.Caption = "読み込み中　" & Str(intCntEve) & " 個"
If intCntEve Mod 10 = 0 Then DoEvents

If GLB_BLN_STOP Then
If MsgBox("中止しますか？", vbYesNo) = vbYes Then
Exit Do
Else
GLB_BLN_STOP = False
End If
End If

If strFilename Like "*" & tbxJyouken.Text & "*" Then
'リストに追加

With lvwList.ListItems.Add
.Text = strFilename
.SubItems(1) = FileDateTime(strFilePath & CST_YEN & strFilename)
End With

End If

' 次のファイル名を参照
strFilename = Dir
Loop

InitAllCtl (True)

lblCopyRun.Caption = "実行中"
GLB_BLN_STOP = False
btnCopyRun.Visible = True
btnCopyStop.Visible = False
lblCopyRun.Visible = False
End Sub

'閉じるクリック
Private Sub btnClose_Click()
UserForm_Terminate
End Sub

'フォーム右上の×クリック
Private Sub UserForm_Terminate()
Dim intBkCnt As Integer

'上書き保存
ThisWorkbook.Worksheets(CST_STR_SETTING).Range(CST_STR_SET_CELL1).Value = tbxPath.Text
ThisWorkbook.Worksheets(CST_STR_SETTING).Range(CST_STR_SET_CELL2).Value = tbxJyouken.Text
ThisWorkbook.Worksheets(CST_STR_SETTING).Range(CST_STR_SET_CELL3).Value = tbxPathEX.Text
ThisWorkbook.Save

If CST_BOO_MODE Then
Unload fmCopy
Exit Sub
End If

'ブックのチェック
intBkCnt = 0
For Each wkbCheck In Workbooks
intBkCnt = intBkCnt + 1
Next wkbCheck
If intBkCnt = 1 Then
'他のExcelブックがなければExcel閉じる
Application.DisplayAlerts = False
Application.Quit
Else
ThisWorkbook.Close SaveChanges:=False
End If
End Sub

'列見出しクリックでソート
Private Sub lvwList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

lvwList.SortKey = ColumnHeader.Index - 1

If lvwList.SortOrder = lvwAscending Then
lvwList.SortOrder = lvwDescending
Else
lvwList.SortOrder = lvwAscending
End If

lvwList.Sorted = True

End Sub


'
''禁止文字変換
'Private Function fncStrChange(strSheetNM As String) As String
'
' Dim strWk As String
'
' '半角にして禁止文字を変換
' strWk = StrConv(strSheetNM, vbNarrow)
' strWk = Replace(strWk, ":", "・")
' strWk = Replace(strWk, "\", "_")
' strWk = Replace(strWk, "?", "_")
' strWk = Replace(strWk, "[", "(")
' strWk = Replace(strWk, "]", ")")
' strWk = Replace(strWk, "/", "_")
' strWk = Replace(strWk, "*", "×")
'
' '戻り値セット
' fncStrChange = strWk
'End Function