2016-03-21 28 views
-1

Ich habe Code in VBA, die Arbeitsblätter mit dem gleichen Registerkartennamen aus verschiedenen Arbeitsmappen in eine Arbeitsmappe kopiert. Die Arbeitsmappen, von denen der Code abgerufen wird, befinden sich in einem Ordner. Der Code funktioniert einwandfrei in Excel 2010, aber wenn ich ihn in Excel 2013 ausführe, erhalte ich die folgende 1004 Fehlermeldung: "Sorry, wir konnten .... xlsx nicht finden. Ist es möglich, dass es verschoben, umbenannt oder gelöscht wurde. " Ich bin mir nicht sicher, wo ich mit der Fehlerbehebung beginnen soll. Ist jemand auf dieses Problem gestoßen oder hat irgendwelche Ideen, warum es in Excel 2010 und nicht in Excel 2013 gut funktionieren würde? Vielen Dank.VBA-Code funktioniert in Excel 2010, aber nicht 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 
+0

Sind Sie sicher, dass es versucht, Referenzdatei noch vorhanden ist, an der gleichen Stelle? –

+0

Wenn es in der von Ihnen angegebenen Zeile bombardiert, ist es wahrscheinlich, dass Sie entweder keinen Ordner mit dem Namen 'Pfadname' als Unterverzeichnis des aktuellen Verzeichnisses haben oder dass' Pfadname' kein Unterverzeichnis namens 'Eingänge' hat . Haben Sie bestätigt, dass beide tatsächlich existieren? Beachten Sie, dass Sie 'PathName' als relatives Verzeichnis angegeben haben (dh es muss in demselben Ordner existieren, in dem Ihr Code ausgeführt wird). –

+0

Ich bin sicher, dass die Referenz immer noch existiert und nichts hat sich geändert, seit ich das letzte Mal in Excel 2010 ausgeführt habe. Der Code wird 2013 verwendet, also versuche ich herauszufinden, was der Unterschied sein könnte. Gibt es eine andere Einstellung, die ich ändern muss? – AMol

Antwort

0

Sind Sie sicher, dass dieser Code zuvor funktioniert hat?

Wenn dies der Fall ist, hat sich der Standarddateipfad Ihrer Anwendung wahrscheinlich geändert. Sie können dies mit Debug.Print Application.DefaultFilePath überprüfen. In jedem Fall wäre es besser, wenn Sie Ihren vollständigen Pfadnamen explizit in Ihrer Variablen sPath definieren würden.

Wenn Sie ältere Excel-Dokumente aufnehmen möchten, könnte die Zeichenfolge in Ihrer Dir-Funktion einfach "* .xls *" sein (aber das würde auch Makro-aktivierte Arbeitsmappen sammeln). Ich frage mich, ob das ursprünglich mit dem Stern in Ihrem Code gemeint war.

Sie müssen das Fenster nicht aktivieren, aber möglicherweise möchten Sie, dass eine Fehlerbehandlungszeile prüft, ob das Blatt "Risiken" in der Arbeitsmappe vorhanden ist.

Es gibt auch eine gewisse Redundanz in Ihrem Code, so dass die ganze Sache sollte in Ordnung arbeiten, wie unten angegeben:

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 
Verwandte Themen