Excel-Makro-Laufzeit 1004 Dokument möglicherweise schreibgeschützt

Question

Ich habe versucht, Daten aus anderen Arbeitsmappen in eine Master-Arbeitsmappe zu extrahieren. Alle diese Arbeitsmappen wurden in einem Ordner gespeichert. Außerdem würde vor dem Extrahieren der Daten die Anzahl der Dateien in dem Ordner überprüft werden. Wenn es nur eine Datei gibt und es sich um die Master-Arbeitsmappe handelt, wird sie angehalten und beendet.

Wenn ich jedoch das Makro lief, blieb es in der Schleife "Do While" hängen. Dann heißt es, dass es einen Laufzeitfehler 1004 hat, das Dokument kann schreibgeschützt oder verschlüsselt sein1.

Ich bin sicher, dass der Pfad korrekt ist.

Unten ist mein Code.

Sub LoopThroughDirectory() 
    Dim MyFile As String 
    Dim erow 
    Dim Filepath As String 
    Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\" 
    MyFile = Dir(Filepath) 

    Do While Len(MyFile) > 0 
    If MyFile = "Import Info.xlsm" Then 
     Exit Sub 
    End If 

    Workbooks.Open (Filepath & MyFile) 
    Range("F9,F12,F15,F19,F21").Select 
    Range("F21").Activate 

    ActiveWindow.SmallScroll Down:=9 
    Range("F9,F12,F15,F19,F21,F27,F30,F33,F37").Select 
    Range("F37").Activate 

    ActiveWindow.SmallScroll Down:=9 
    Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41").Select 
    Range("F41").Activate 

    ActiveWindow.SmallScroll Down:=-27 
    Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select 
    Range("F6").Activate 
    Selection.Copy 
    ActiveWorkbook.Close 

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 11)) 
    MyFile = Dir 
    Loop 
End Sub 

Und meine Fragen sind,

1. Ich weiß nicht, wo ich schief gelaufen ist mit dem "Do while" Schleife
2. Wie die Laufzeit 1004 Fehler zu beheben.

Kann mir jemand beraten? Danke vielmals!

Answer 1

Scheint mir, Sie verwenden die Schleife, um die Dateien zu öffnen, anstatt es manuell zu tun. Nicht sicher, warum die Schleife stecken geblieben ist, es sei denn, Sie hatten die Zeile MyFile = Dir zur Laufzeit nicht oder kommentiert.

@Thomas ist meistens richtig, der Fehler 1004 tritt auf, weil die Quellarbeitsmappe zu früh geschlossen wird. Allerdings konnte ich die Werte mit wkbTarget.worksheets(1).paste einfügen, aber es eingefügt alle Zellen zwischen F6 bis F41 - nicht was Sie wollen.

Darüber hinaus ist Ihr Kopierbereich 11 Zeilen, 1 Spalte, aber Sie geben einen Zielbereich von 1 Zeile, 11 Spalten an: Cells(erow, 1), Cells(erow, 11). Wenn Sie das wirklich wollen, sollten Sie use Transpose. Mit Cells(#,#) innerhalb Range() produziert auch 1004 Fehler, aber Cells(#,#).address löste es.

Hier ist mein nehmen:

Sub LoopThroughDirectory() 
    Dim MyFile As String 
    Dim wkbSource as Workbook 
    Dim wkbTarget as Workbook 
    Dim erow as single 
    Dim Filepath As String 

    Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\" 
    MyFile = Dir(Filepath) 

    Set wkbTarget = Workbooks(MyFile)     'Assuming the file is already open 

    Do While Len(MyFile) > 0 
    If MyFile = "Import Info.xlsm" Then Goto NextFile 'Skip the file instead of exit the Sub 

    Set wkbSource = Workbooks.Open (Filepath & MyFile) 'Set a reference to the file being opened 
    wkbSource.worksheet(1).Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select 
    Selection.Copy 

    erow = wkbTarget.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    wkbTarget.Worksheets("Sheet1").Paste Destination:=wkbTarget.Worksheets("Sheet1").Range(Cells(erow, 1).address) 

    wkbSource.Close 

NextFile: 
    MyFile = Dir 

    Loop 
    End Sub 

Thomas einzeiligen copy + paste-Methode ist schön übersichtlich. Sie könnten die Codezeilen neu anordnen, um diesen Ansatz zu verwenden. Ich empfehle nur, die Quell- und Zielobjekte zu löschen.