初めて投稿します。助けてください。
以下のVBAを使用して業務を行っているのですが
このマクロが動かなくなってしまいました。
ネット等で調べてわかったのですが
XP問題で社内PCがすべて変わりExcelも２０１３になってしまい
２０１３では、下記に記載されているFileSearch機能が使用できないようです。
出来れば下記の分をExcel２０１３でも
動くようにどの部分を変更すればいいいか教えていただけないでしょうか？
---------------------＜VBA文＞-------------------------
Sub 作成()
Dim i, j, no As Integer
Dim Mpath, Mname, Mfull As String
Mpath = ActiveWorkbook.Path
Mname = ActiveWorkbook.Name
Mfull = Mpath & "\" & Mname
Worksheets("一覧").Select
Range("A2:A200").Clear
With Application.FileSearch
.NewSearch
.LookIn = Mpath
.Filename = "*.xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .Execute
If .FoundFiles(i) <> Mfull Then
Cells(i + 1, 1).Value = .FoundFiles(i)
j = Len(Cells(i + 1, 1))
If j > 218 Then
MsgBox ("218文字を超えてます。")
Exit Sub
End If
End If
Next i
Else
MsgBox ("見つかりませんでした。")
End If
End With
Range("A2").Select
Range("A2:A1000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
End Sub
例えば、こんな感じでいかがでしょうか。
----------
Sub 作成()
Dim i As Integer, j As Integer, no As Integer
Dim Mpath As String, Mname As String, Mfull As String
Mpath = ActiveWorkbook.Path
Mname = ActiveWorkbook.Name
Mfull = Mpath & "\" & Mname
Worksheets("一覧").Select
Range("A2:A200").Clear
Dim result() As String
Call search(Mpath, result())
If UBound(result) > 0 Then
For i = 0 To UBound(result)
If result(i) <> Mfull Then
Cells(i + 1, 1).Value = result(i)
j = Len(Cells(i + 1, 1))
If j > 218 Then
MsgBox ("218文字を超えてます。")
Exit Sub
End If
End If
Next i
Else
MsgBox ("見つかりませんでした。")
End If
Range("A2").Select
Range("A2:A1000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
End Sub
Sub search(Mpath As String, result() As String)
Dim arrayFilePath As String
arrayFilePath = Dir(Mpath & "*.xls")
Dim i As Integer
i = 0
ReDim result(i)
Do Until arrayFilePath = ""
ReDim Preserve result(i)
result(i) = Mpath & arrayFilePath
i = i + 1
arrayFilePath = Dir()
Loop
End Sub
