初めて投稿します。助けてください。
以下のVBAを使用して業務を行っているのですが
このマクロが動かなくなってしまいました。
ネット等で調べてわかったのですが
XP問題で社内PCがすべて変わりExcelも2013になってしまい
2013では、下記に記載されているFileSearch機能が使用できないようです。
出来れば下記の分をExcel2013でも
動くようにどの部分を変更すればいいいか教えていただけないでしょうか?
---------------------<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
No.1ベストアンサー
- 回答日時:
例えば、こんな感じでいかがでしょうか。
----------
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) 動きっぱなしです。止め方とプロシージャの間違いを教えて下さい! 5 2022/08/15 23:08
- Visual Basic(VBA) Excel VBAの解読について質問があります。 概要は、マクロでチェックボックスにチェックすると日 1 2023/02/10 07:50
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) excel VBA if文について 3 2022/03/27 17:42
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
社内の電話の場合、自分の部署...
-
社内の人間に対して「○○さんは...
-
社内のDX化を推進するために何...
-
CMとAGがなんの役職だか分...
-
社内向け送付状について
-
かしこまりました・承知いたし...
-
職務領域?
-
社内用業務報告書、敬称表記に...
-
バイヤー誘惑の社内規定
-
社内秘と社外秘の意味は?
-
スギ薬局の店員の方来てくださ...
-
使用済み業務日報をメモ用紙に
-
商品制作費のデータ管理の方法...
-
個人情報保護方針の社内規定
-
VA提案とVE提案の違いは ?
-
事後稟議書の書き方をお教え下さい
-
採用に関する社内稟議とはなん...
-
後閲について
-
目標管理シートの書き方
-
駐車場(砂利)での白線の素材
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
社内の電話の場合、自分の部署...
-
社内の人間に対して「○○さんは...
-
社内用業務報告書、敬称表記に...
-
CMとAGがなんの役職だか分...
-
(社内メール)E-maiのアドレス変...
-
運賃値上げの陳情に対する回答...
-
職務領域?
-
社外(下請け)と社内関係者にメ...
-
代理の手紙の表記の仕方
-
社内秘と社外秘の意味は?
-
「様」「殿」「さん」等の使い...
-
社内向け送付状について
-
私の勘違いでアポの日程を間違...
-
QMSとTQMの関係
-
社内電話応対
-
スギ薬局の店員の方来てくださ...
-
【電話対応】社内行事で不在の場合
-
取引先との秘密の飲み会
-
かしこまりました・承知いたし...
-
社内預金利率の上限について
おすすめ情報