Excel 2010'da VBA Kodu Çalışıyor Ama Excel 2013'te Çalışmıyor

Question

VBA'da, çalışma sayfalarını farklı çalışma kitaplarındaki aynı sekme adıyla bir çalışma kitabına kopyalar. Kodun çektiği çalışma kitapları bir klasörde. Kod, Excel 2010'da düzgün çalışıyor ancak Excel 2013'te çalıştırdığımda, şu 1004 hata iletisini alıyorum: "Üzgünüz, bulamadık .... xlsx. Taşındı, yeniden adlandırıldı veya silindi. " Sorun gidermeye nereden başlayacağımı bilmiyorum. Bu problemle karşılaşan biri var mı, yoksa Excel 2010'da Excel 2010'da neden iyi çalıştığı konusunda herhangi bir fikriniz var mı? Teşekkür ederim.

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

Bu kodun daha önce çalıştığından emin misiniz?

Olduysa, uygulamanızın varsayılan dosya yolu büyük olasılıkla değişti. Bunu Debug.Print Application.DefaultFilePath ile kontrol edebilirsiniz. Her durumda, tam yol adınızı sPath değişkeninizde açıkça tanımlamanız daha iyi olur.

Eski Excel belgelerini almak istiyorsanız, Dir işlevindeki dize yalnızca "* .xls *" olabilir (ancak bu makro etkinleştirilmiş çalışma kitaplarını da toplar). Özgün kodunuzda asteriks ile amaçlanmış olup olmadığını merak ediyorum.

Pencereyi etkinleştirmeye gerek yoktur, ancak çalışma kitabında "Riskler" sayfasının olup olmadığını kontrol etmek için bir hata işleme satırı isteyebilirsiniz.

Orada sizin kod bir miktar tekrar ayrıca, bu yüzden her şey aşağıda verildiği gibi tamam çalışmak gerektiğini:

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