Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
Screenshot zu InputBox	InputBox-Seite mit Beispielarbeitsmappe aufrufen

filecopy

• filecopy von Meinolf vom 19.04.2003 - 21:01:55
  • Re: filecopy von MRR vom 19.04.2003 - 21:56:55
  • Re: filecopy von Meinolf vom 19.04.2003 - 22:14:48
  • Ausserdem läuft es nicht... von Ramses vom 19.04.2003 - 23:05:22
  • End If ... fehlt von Ramses vom 19.04.2003 - 22:38:24
  • Re: End If ... fehlt von Meinolf vom 19.04.2003 - 23:08:14
  • Schau in meinen anderen Beitrag :-) o.T. von Ramses vom 19.04.2003 - 23:12:22
  • Re: Schau in meinen anderen Beitrag :-) o.T. von Meinolf vom 19.04.2003 - 23:20:38
  • Dass du dich bedankst ist schon genug :-)) von Ramses vom 19.04.2003 - 23:32:30
  • re Forum von Meinolf vom 19.04.2003 - 23:57:10

Betrifft: filecopy
von: Meinolf
Geschrieben am: 19.04.2003 - 21:01:55

Hallo excel user,
ich möchte gern ein Verzeichnis auf Laufwerk j: sichern,
das Makro läuft aber nicht durch,
hier der code

FileCopy "C:\123V5W\SONST\*.*", "j:\123V5W\SONST\"

Weis jemand wie der richtige befehl lauten könnte ?
Herzlichen Dank schon mal im voraus.
Mfg Meinolf

Re: filecopy
von: MRR
Geschrieben am: 19.04.2003 - 21:56:55

Hi Meinolf,
versuch doch mal was wie das hier:

With Application.FileSearch
  If .Execute() > 0 Then
    For i = 1 To .FoundFiles.Count
      FileCopy .FoundFiles(i), "J:\123V5W\SONST\"
    Next
End With

Oder wie wäre es mit "DOS"-Zugriffen?
Matthias

Re: filecopy
von: Meinolf
Geschrieben am: 19.04.2003 - 22:14:48

Danke für deine schnelle Hilfe,

der makro läuft noch nicht Problem Fehlermeldung
Fehler beim kompilieren: end with ohne with

Mfg Meinolf

End If ... fehlt
von: Ramses
Geschrieben am: 19.04.2003 - 22:38:24

Hallo,

With Application.FileSearch
  If .Execute() > 0 Then
    For i = 1 To .FoundFiles.Count
      FileCopy .FoundFiles(i), "J:\123V5W\SONST\"
    Next
End If
End With

Gruss Rainer

Ausserdem läuft es nicht...
von: Ramses
Geschrieben am: 19.04.2003 - 23:05:22

Hallo,

weil
A) in der Variablen ".FoundFiles(i)" der Pfad mit enthalten ist. Somit kann die Datei nicht kopiert werden.

B) Der Zieldateiname nicht definiert ist

C) Der Suchpfad nicht definiert ist

D) Der zu suchende Dateityp nicht definiert ist

Option Explicit

Sub FileBackup()
Dim i As Long, TotFiles As Long
Dim gefFile As String, dname As String
Dim Suchpfad As String, suchbegriff As String, Zielpfad As String
Dim oldStatus As Variant, dateiform As String
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Zielpfad = InputBox("Geben Sie den Ordner an, in den kopiert werden soll.", "Pfad definieren", "C:\Temp")
If Zielpfad = "" Then Exit Sub
dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
With Application.FileSearch
    .LookIn = Suchpfad
    'Wenn auch Unterordner durchsucht werden sollen
    'den Typ auf TRUE setzen
    .SearchSubFolders = False
    .Filename = dateiform
    If .Execute() > 0 Then
        TotFiles = .FoundFiles.Count
        Application.StatusBar = "Total " & TotFiles & " gefunden"
        For i = 1 To .FoundFiles.Count
            gefFile = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\", -1))
            FileCopy Suchpfad & "\" & gefFile, Zielpfad & "\" & gefFile
        Next i
    End If
End With
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
End Sub 

     Code eingefügt mit Syntaxhighlighter 1.16

Gruss Rainer

Re: End If ... fehlt
von: Meinolf
Geschrieben am: 19.04.2003 - 23:08:14

Hallo Ramses,
danke für deine Mühe
der Makro bricht weiterhin ab (kann Pfad nicht finden).
Mir ist auch nicht klar welche
Dateien er wo sucht und selektiert.

Mfg Meinolf

Schau in meinen anderen Beitrag :-) o.T.
von: Ramses
Geschrieben am: 19.04.2003 - 23:12:22

..

Re: Schau in meinen anderen Beitrag :-) o.T.
von: Meinolf
Geschrieben am: 19.04.2003 - 23:20:38

Hallo Ramses,
einfach genial dein Makro
da wäre ich so nie drauf gekommen.
Der Makro erspart mir eine Menge Arbeit, da ich viele unterschiedliche Dateien und Verzeichnisse sichern möchte.
Wie kann ich mich bei dir bedanken ?

Mfg Meinolf

Dass du dich bedankst ist schon genug :-))
von: Ramses
Geschrieben am: 19.04.2003 - 23:32:30

Hallo Meinolf.

Wenn du viele Dateien in unterschiedlichen Verzeichnisses sichern musst, gibt es in dieser Variante noch die Möglichkeit mit einer Schleife. Dann kannst du das in einer Tabelle definieren und automatisch laufen lassen.
Dann musst du es nicht jedesmal neu eingeben :-))

Die Tabelle muss so aufgebaut sein, und die jeweiligen Verzeichnisse MÜSSEN existieren.
Ich habe keine Fehlerroutine für nicht existierende Verzeichnisse eingebaut:

Tabelle1

A B C 1 Pfad Dateityp Zielpfad 2 C:\Temp *.* D:\ Backup 3 C:\Windows *.txt D:\Backup 4 C:\Office\Excel *.xls D:\Excel\Backup

Excel Tabellen einfach im Web darstellen   Excel Jeanie HTML  2.0    Download  

und das passende Makro.

Option Explicit

Sub FileBackup()
Dim i As Long, TotFiles As Long
Dim n As Long, Cr As Long
Dim gefFile As String, dname As String
Dim Suchpfad As String, suchbegriff As String, Zielpfad As String
Dim oldStatus As Variant, dateiform As String
Cr = 65536
'Letzten Eintrag in Spalte A suchen
If Cells(Cr, 1) = "" Then
    Cr = Cells(Cr, 1).End(xlUp).Row
End If
'Schleife für automatisches Backup starten
For n = 2 To Cr
    Suchpfad = Cells(i, 1)
    dateiform = Cells(i, 2)
    Zielpfad = Cells(i, 3)
    Application.ScreenUpdating = True
    oldStatus = Application.StatusBar
    With Application.FileSearch
        .LookIn = Suchpfad
        'Wenn auch Unterordner durchsucht werden sollen
        'den Typ auf TRUE setzen
        .SearchSubFolders = False
        .Filename = dateiform
        If .Execute() > 0 Then
            TotFiles = .FoundFiles.Count
            Application.StatusBar = "Total " & TotFiles & " gefunden"
            For i = 1 To .FoundFiles.Count
                gefFile = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\", -1))
                FileCopy Suchpfad & "\" & gefFile, Zielpfad & "\" & gefFile
            Next i
        End If
    End With
    Application.StatusBar = oldStatus
    Application.ScreenUpdating = True
Next n
End Sub 

     Code eingefügt mit Syntaxhighlighter 1.16

Viel Spass

Gruss Rainer

re Forum
von: Meinolf
Geschrieben am: 19.04.2003 - 23:57:10

Hallo Ramses,
dann wünsche ich dir viele Ostergrüsse,

und lass dir die Stimmung nicht vermiesen,
vielleicht sollte man
wie in ebay eine bewertungsfunktion in das Forum miteinbauen.

Mfg Meinolf