mark47
Goto Top

Datei Tabellenblatt kopieren

Der Kode macht in Zeile
MkDir DestFolder
probleme. Fehlermeldung: Laufzeitfehler 75, Fehler beim Zugriff auf Pfad / Datei. Für mich sind die Pfade richtig geschrieben, verstehe die Meldung daher nicht.

Sub KopiereDatei()
    Dim FSO As Object
    Dim SourceFile As String
    Dim DestFolder As String

    SourceFile = "C:\Users\Besitzer\Desktop\Datei für DEMO\Info.xlsb"   ' Pfad zur Quelldatei  

    DestFolder = "C:\Users\Besitzer\Desktop\Tabelle_Test.xlsx"          ' Pfad zum Zielordner (ohne Dateiname)  

    If Not FolderExists(DestFolder) Then                                ' Überprüfen, ob der Zielordner existiert, wenn nicht, erstellen  
        MkDir DestFolder
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")                ' Erstellen des FileSystemObject  

    If FSO.FileExists(SourceFile) Then                                  ' Kopieren der Datei  
        FSO.CopyFile Source:=SourceFile, Destination:=DestFolder
        MsgBox "Die Datei wurde erfolgreich kopiert.", vbInformation  
    Else
        MsgBox "Die Quelldatei wurde nicht gefunden.", vbExclamation  
    End If

    Set FSO = Nothing                                                   ' Freigabe des FileSystemObject  
End Sub

Function FolderExists(ByVal FolderPath As String) As Boolean
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    FolderExists = FSO.FolderExists(FolderPath)
    Set FSO = Nothing
End Function

Content-Key: 5322735252

Url: https://administrator.de/contentid/5322735252

Printed on: April 27, 2024 at 11:04 o'clock

Member: accessViolation
accessViolation Mar 25, 2024 updated at 10:46:56 (UTC)
Goto Top
Hi.

Zeile 8: DestFolder = "C:\Users\Besitzer\Desktop\Tabelle_Test.xlsx" ' Pfad zum Zielordner (ohne Dateiname)
Lies mal den Kommentar(nach dem Hochkomma) durch und was mkdir so veranstaltet. Dann kommste alleine auf die Lösung (und auch darauf, warum das gar nicht funktionieren sollte).

Gruß
Member: mark47
mark47 Mar 25, 2024 at 12:01:01 (UTC)
Goto Top
Der Kode produziert mir dann einen neuen Ordner, aber keine neue Datei mit Inhalt.
Member: DivideByZero
DivideByZero Mar 25, 2024 at 13:18:15 (UTC)
Goto Top
Was auch sonst? Works as designed.
MkDir erzeugt ein Directory/einen Ordner.
Du sagt: erzeuge den Ordner "C:\Users\Besitzer\Desktop\Tabelle_Test.xlsx".
Das passiert. Der Ordner heißt "Tabelle_Test.xlsx". Das ist ein zulässiger Ordnername, wie auch ein zulässiger Dateiname. Hier ein Ordnername.

Da dann der Ordner "Tabelle_Test.xlsx" unter Desktop besteht, muss der Kopiervorgang fehlschlagen. In einem Ordner (hier: Desktop) können nicht ein Unterordner und eine Datei identischen Namens existieren.

Du willst aber wohl eher (oder Dein AI-Code, den Du nicht verstehst?):
1. Prüfe, ob der Zielordner existiert (bei Desktop eher sinnfrei...).
2. Falls nicht, erzeuge Zielordner
3. Kopiere dann die Quelldatei in den Zielordner

Dann muss der Zielordner schlicht "C:\Users\Besitzer\Desktop" heißen.

Lies Dir auch mal die Beschreibung von CopyFile durch.

Gruß

DivideByZero
Member: mark47
mark47 Mar 25, 2024 at 13:44:17 (UTC)
Goto Top
Hallo, ich muss meine Frage ergänzen, denn ich wollte aus der "Datei für Demo" nur die Tabelle "Info" kopieren, und diese als neue Datei auf dem Desktop einfügen. Mein neuer Code s. u. kopiert mir aber die Datei. Das ist mein eigentliches Problem

Sub KopiereDatei()
    Dim FSO As Object
    Dim SourceFile As String
    Dim DestFolder As String
    
    ' Pfad zur Quelldatei  
    SourceFile = "C:\Users\Besitzer\Desktop\Datei für DEMO.xlsb"  
    
    ' Pfad zum Zielordner (ohne Dateiname)  
    DestFolder = "C:\Users\Besitzer\Desktop\Tabelle_Test\"  
    
    ' Erstellen des FileSystemObject  
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    
    ' Überprüfen und Erstellen des Zielordners, falls nicht vorhanden  
    If Not FSO.FolderExists(DestFolder) Then
        MkDir DestFolder
    End If
    
    ' Kopieren der Datei  
    If FSO.FileExists(SourceFile) Then
        FSO.CopyFile Source:=SourceFile, Destination:=DestFolder
        MsgBox "Die Datei wurde erfolgreich kopiert.", vbInformation  
    Else
        MsgBox "Die Quelldatei wurde nicht gefunden.", vbExclamation  
    End If
    
    ' Freigabe des FileSystemObject  
    Set FSO = Nothing
End Sub
Mitglied: 12168552861
12168552861 Mar 25, 2024 at 14:02:25 (UTC)
Goto Top
Member: mark47
mark47 Mar 25, 2024 at 14:31:05 (UTC)
Goto Top
Habe ich jetzt verwendet, in der MsgBox werde ich nach der Datei gefragt, aber wie wähle ich denn das entsprechende Tabellenblatt (Quelldatei) aus, welches ich kopieren will?
Mitglied: 12168552861
12168552861 Mar 25, 2024 updated at 14:38:52 (UTC)
Goto Top
Zitat von @mark47:

Habe ich jetzt verwendet, in der MsgBox werde ich nach der Datei gefragt, aber wie wähle ich denn das entsprechende Tabellenblatt (Quelldatei) aus, welches ich kopieren will?

Indem du mal die Kommentare des Codes liest ... 💩
' ....  
    'Sheet kopieren    
    wbQuelle.Worksheets("Tabelle1").Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)    
    
Member: mark47
mark47 Mar 26, 2024 at 10:15:00 (UTC)
Goto Top
Hallo und Danke für die Hinweise. Der Code funktioniert perfekt. Eine Frage hätte ich aber noch. Kann man beim Kopieren der Tabelle die Herkunft der Formeln ohne den "Pfad" mitzukopieren einrichten?

Private Sub CommandButton1_Click()

    Dim wbQuelle As Workbook, wbZiel As Workbook, strPathQuelle, strPathZiel

    'Dateinamen anfordern  
    strPathQuelle = Application.GetOpenFilename()
    strPathZiel = Application.GetOpenFilename()
    
    If strPathQuelle = False Then
        MsgBox "Es wurde keine Quelldatei ausgewählt.", vbOKOnly  
        Exit Sub
    End If
    If strPathZiel = False Then
        MsgBox "Es wurde keine Zieldatei ausgewählt.", vbOKOnly  
        Exit Sub
    End If

    Application.ScreenUpdating = False

    'Workbooks öffnen  
    Set wbQuelle = Workbooks.Open(strPathQuelle)
    Set wbZiel = Workbooks.Open(strPathZiel)
    
    ' Tabellenblatt (Sheet) kopieren  
    ' Hier muß das zu kopierende Tabellenblatt ("   ") eingetragen werden.  
    wbQuelle.Worksheets("Info").Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)  
    
    'Quell-Workbook schließen (nicht speichern)  
    wbQuelle.Close True  '  False  
    'Ziel-Workbook schließen und speichern  
    wbZiel.Close True
    
    'Quell-Workbook löschen  
    ''' Kill (strPathQuelle)  
    
    Application.ScreenUpdating = True
    MsgBox "Daten wurden übernommen.", vbOKOnly  

End Sub