VBAコードはExcel 2010で動作しますがExcel 2013では使用できません

Question

VBAには、異なるブックの同じタブ名のワークシートを1つのブックにコピーするコードがあります。コードが取得するブックは1つのフォルダにあります。私がExcel 2013で実行すると、コードはExcel 2010で正常に動作していますが、次の1004エラーメッセージが表示されます： "申し訳ありませんが、.... xlsxが見つかりませんでした。 "トラブルシューティングを開始する場所がわかりません。誰もこの問題に遭遇したのですか、それともExcel 2013ではなく正常に動作するのかというアイデアはありますか？ありがとうございました。

Sub CombineSheets() 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Dim sPath As String 
Dim sFname As String 
Dim wBk As Workbook 
Dim wSht As Variant 

Application.EnableEvents = False 
Application.ScreenUpdating = False 
sPath = "PathName\Inputs" 
ChDir sPath 
sFname = "*" 
sFname = Dir(sPath & "\" & sFname & ".xlsx*", vbNormal) <Code bombs here> 
wSht = ("Risks") 
Do Until sFname = "" 
    Set wBk = Workbooks.Open(sFname) 
    Windows(sFname).Activate 
    Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1) 
    wBk.Close False 
    sFname = Dir() 
Loop 
ActiveWorkbook.Save 
Application.EnableEvents = True 
Application.ScreenUpdating = True 

Answer 1

このコードは以前に動作していましたか？

もしそうなら、アプリケーションのデフォルトのファイルパスがおそらく変更されています。これはDebug.Print Application.DefaultFilePathで確認できます。いずれの場合でも、sPath変数に完全パス名を明示的に定義する方がよいでしょう。

従来のExcelドキュメントを取得する場合は、Dir関数内の文字列を "* .xls *"にすることができます（ただしマクロ対応のブックを収集することもできます）。私はそれがもともとあなたのコードのアスタリスクで意図されたのだろうかと思います。

ウィンドウをアクティブにする必要はありませんが、「リスク」シートがブックに存在するかどうかを確認するためのエラー処理ラインが必要な場合があります。

全体のことは下記の通り大丈夫働くべきだので、あなたのコード内のいくつかの冗長性は、もあります：

Sub CombineSheets() 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 

    Dim sPath As String 
    Dim sFname As String 
    Dim wBk As Workbook 
    Dim wSht As Worksheet 

    Application.EnableEvents = False 
    Application.ScreenUpdating = False 
    sPath = "PathName\Inputs" 'make this a full path eg "C:\..." 
    sFname = Dir(sPath & "\" & "*.xls*", vbNormal) 
    Do Until sFname = "" 

     'skip if it's this workbook 
     If sFname <> ThisWorkbook.Name Then 
      Set wBk = Workbooks.Open(sPath & "\" & sFname) 

      'check a "Risks" sheet exists 
      Set wSht = Nothing 
      On Error Resume Next 
      Set wSht = wBk.Sheets("Risks") 
      On Error GoTo 0 

      If Not wSht Is Nothing Then 
       wSht.Copy Before:=ThisWorkbook.Sheets(1) 
      End If 

      wBk.Close False 

     End If 

     sFname = Dir() 
    Loop 
    ActiveWorkbook.Save 
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 

End Sub