Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.05.2024 19:56:55
Mit Schaltfläche (VBAMacro) zur aktuellen Woche springen
19.05.2024 19:42:43
zeilen löschen wenn
19.05.2024 17:55:54
Problem mit Formel countif
19.05.2024 17:28:17
E-Mailadressen Alphabetisch sortieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1788to1792
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1788to1792
1788to1792
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

filecopy

filecopy
19.10.2020 19:46:23
Benedikt
Guten Abend Profis
Mit nachfolgendem Code lege ich einen neuen Unterordner (Name und Vorname) an und speichere die aktuelle .xlsm darin. Funktioniert einwandfrei
Ich würde gerne noch zwei weitere (Word und Excel) Dateien in diesen neuen Unterordner kopieren. Aber genau daran beisse ich mir die Zähne aus
Sub Ordner()
Application.DisplayAlerts = False
Dim TWS As Worksheet
Set TWS = ThisWorkbook.ActiveSheet
With TWS
SaveName = .Range("C7") & (" ") & Range("C9").Value
Pfad = "C:\Test\Mitglieder\"
If Dir(Pfad & SaveName, vbDirectory)  "" Then
MsgBox "Mitglied mit gleichem Namen existiert bereits" & vbCr & "Zusatz bei Name oder Vorname  _
anbringen"
Else
'MsgBox "Daten geändert I.O"
Unload Mitglied
MkDir (Pfad & SaveName)
.SaveAs Pfad & SaveName & "\" & SaveName & ".xlsm", 52
End If
End With
Application.DisplayAlerts = True
End Sub
Vielen Dank für Hilfe

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: filecopy
19.10.2020 23:53:05
volti
Hallo Benedikt,
ich kann an dem Code nicht erkennen, wie und wo Du zwei weitere Dateien in den neuen Ordner kopierst.
Zum Kopieren könntest Du z.B. nachfolgendes Codemuster verwenden:

CreateObject("Scripting.FileSystemObject").CopyFile _
         "C:\Quelle\" & sDateiname, Pfad & SaveName & "" & sDateiname
viele Grüße
Karl-Heinz
Anzeige
AW: filecopy
20.10.2020 05:47:50
Benedikt
Vielen Dank Karl-Heinz
wie und wo Du zwei weitere Dateien in den neuen Ordner kopierst - genau das ist die Frage
Wie kann ich zwei weitere Dateien in den neuen Ordner kopieren.
Dein Vorschlag mit CreateObject scheint aber der richtige Weg
Mein Versuch bringt Laufzeitfehler 70, allerdings wird Pfad & Savename erkannt, nur sDateiname ist leer.
.
.
MkDir (Pfad & SaveName)
.SaveAs Pfad & SaveName & "\" & SaveName & ".xlsm", 52
End If
End With
CreateObject("Scripting.FileSystemObject").CopyFile _
"C:\Test\Worddateien\Auswertung.docx" & sDateiname, Pfad & SaveName & "" & sDateiname
Anzeige
AW: filecopy
20.10.2020 08:48:50
volti
Hallo Benedikt,
sDateiname ist eine Variable, die noch mit einem Dateinamen gefüllt werden muss. Da das nicht erfolgt ist, ist der Zielpfad unvollständig und es kommt zum angezeigten Fehler.
Hier noch mal ein (ungetesteter) Versuch, Dein Vorhaben umzusetzen. Bitte die Dateinamen und Pfade entsprechend anpassen.
PS: MKDIR erstellt immer nur den letzten Pfadteil, d.h. in diesem Fall, dass der Ordner C:\Test\Mitglieder schon vorhanden sein muss.

Code:


[Cc][+][-]
 
Sub Ordner()
  Dim sPfad As String, sSaveName As String, sDateiname As String
  
  Application.DisplayAlerts = False
  
  With ThisWorkbook.ActiveSheet
  
'Dateinamen aus dem aktiven Blatt entnehmen
    sSaveName = .Range("C7") & (" ") & Range("C9").Value
    sPfad = "C:\Test\Mitglieder\"
  
    If Dir(sPfad & sSaveName, vbDirectory) <> "" Then
'Meldung, falls Verzeichnis schon existiert
       MsgBox "Mitglied mit gleichem Namen existiert bereits" _
              & vbCr & "Zusatz bei Name oder Vorname anbringen ", _
              vbExclamation, "Fehlermeldung"
  
    Else
  
'MsgBox "Daten geändert I.O"
'       Unload Mitglied                 'Userform schließen?
  
       MkDir (sPfad & sSaveName)        'Verzeichnis erstellen

'Dieses Blatt abspeichern
       .SaveAs sPfad & sSaveName & "&bsol;" & sSaveName & ".xlsm", 52

'Weitere Dateien kopieren
       With CreateObject("Scripting.FileSystemObject")
           sDateiname = "Auswertung.docx"
           .CopyFile "C:&bsol;Test&bsol;Worddateien&bsol;" & sDateiname, sPfad & sSaveName & sDateiname
           sDateiname = "Auswertung.xlsx"
           .CopyFile "C:&bsol;Test&bsol;Exceldateien&bsol;" & sDateiname, sPfad & sSaveName & sDateiname
       End With

     End If
     
  End With
  
  Application.DisplayAlerts = True
  
End Sub
 
____________________
viele Grüße aus Freigericht
Karl-Heinz

Anzeige
Vielen Dank Volti
20.10.2020 09:01:39
Benedikt
Vielen Dank Karl-Heinz für die detailierte Erklärung, den Angepassten Code und deine Zeit.
Ich wünsche Dir einen guten Tag
AW: filecopy @volti
22.10.2020 21:21:45
Benedikt
Vielleicht kann kannst Du mir noch einmal helfen
Der Code legt den Ordner im Verzeichnis C:\Test anhand Text in Zelle C7 und C9 an.
Beim CopyFile passiert aber folgendes: Anstelle den Ordner Auswertung.docx in den neu angelegten Ordner zu kopieren, wird eine neue Datei im Verzeichnis Test angelegt bestehend aus Name VornameAuswertung.docx.
Ich habe einen Screenshot beigelegt
https://www.herber.de/bbs/user/141029.xlsm
Anzeige
AW: filecopy @volti
22.10.2020 23:20:18
volti
Hallo Benedikt,
da fehlte wohl nur ein "\".
Schau mal, ob's jetzt passt.

Code:


[Cc][+][-]
 
Sub Ordner()
  Dim sPfad As String, sSaveName As String, sDateiname As String
  
  Application.DisplayAlerts = False
  
  With ThisWorkbook.ActiveSheet
  
'Dateinamen aus dem aktiven Blatt entnehmen
    sSaveName = .Range("C7") & (" ") & Range("C9").Value
    sPfad = "C:&bsol;Test&bsol;Mitglieder&bsol;"
  
    If Dir(sPfad & sSaveName, vbDirectory) <> "" Then
'Meldung, falls Verzeichnis schon existiert
       MsgBox "Mitglied mit gleichem Namen existiert bereits" _
              & vbCr & "Zusatz bei Name oder Vorname anbringen ", _
              vbExclamation, "Fehlermeldung"
  
    Else
  
'MsgBox "Daten geändert I.O"
'       Unload Mitglied                 'Userform schließen?
  
       MkDir (sPfad & sSaveName)        'Verzeichnis erstellen

'Dieses Blatt abspeichern
       .SaveAs sPfad & sSaveName & "&bsol;" & sSaveName & ".xlsm", 52

'Weitere Dateien kopieren
       With CreateObject("Scripting.FileSystemObject")
           sDateiname = "Auswertung.docx"
           .CopyFile "C:&bsol;Test&bsol;Worddateien&bsol;" & sDateiname, sPfad & sSaveName & "&bsol;" & sDateiname
           sDateiname = "Auswertung.xlsx"
           .CopyFile "C:&bsol;Test&bsol;Exceldateien&bsol;" & sDateiname, sPfad & sSaveName & "&bsol;" & sDateiname
       End With

     End If
     
  End With
  
  Application.DisplayAlerts = True
  
End Sub
 
____________________
viele Grüße aus Freigericht
Karl-Heinz

Anzeige
Perfekt
23.10.2020 05:33:18
Benedikt
Vielen Dank Karl-Heinz du bist mein Held des Tages.....

Links zu Excel-Dialogen

UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige