Informationen und Beispiele zum Thema InputBox | |
---|---|
![]() |
InputBox-Seite mit Beispielarbeitsmappe aufrufen |
![]() |
![]() ![]() |
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
![]() ![]() |
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
Sub FileBackup()
Code eingefügt mit Syntaxhighlighter 1.16
Option Explicit
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
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 | ||||||||||||||||||||
|
und das passende Makro.
Sub FileBackup()
Code eingefügt mit Syntaxhighlighter 1.16
Option Explicit
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
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
![]() |