Dateien verschieben und weiterzählen

Bild

Betrifft: Dateien verschieben und weiterzählen
von: Rene
Geschrieben am: 16.02.2005 09:09:52
Moin zusammen,
Ich bin ganz doll am verzweifeln habe fast die ganze Nacht an meinem Prog gebastelt und versucht mein Problem zu lösen, aber ich bekomme es einfach nicht hin oder sollte es gar nicht möglich sein? Bitte Bitte kann sich nicht jemand mal der sich 100 mal besser auskennt damit befassen? Gebe hier noch mal eine Auflistung was ich machen möchte:
1: Ich habe in einem Ordner(C:\Temp) immer Dateien liegen, diese heisen:
000.txt
000.ps
001.txt
001.ps
.....
050.txt
050.ps
nun muß ich diese Dateien in einen Ordner verschieben aber ich müßte ein Fenster mit Ordner Auswahl bekommen. Wenn diese dann verschoben sind liegen sie als Beispiel im Ordner(C:\Temp\Test),nun bekomme ich in den Ordner (C:\Temp) wieder Dateien diese heisen ebenfalls wie unter 1. aufgelistet, diese möchte ich nun wieder in den Ordner(C:\Temp\Test) verschieben. Da aber ja Dateien mit gleichem Namen liegen müßten diese neuen Dateien umbennant werden das sie weiterzählen heisen:
051.txt
051.ps
052.txt
052.ps
....
067.txt
067.ps
So würde das immer weiter gehen.
Die Unterordner im Verzeichnis C:\Temp würde ich aber gerne immer selber erstellen wollen, aber der Ablauf für jeden UnterOrdner wäre der gleiche (mit dem verschieben und umbennenen der Name des UnterOrdners ändert sich aber). Ich glaube fast das das ganz schön schwierig ist aber ich habe hier schon so viel Hilfe bekommen und hoffe daher das mein Problem gelöst wird. Falls die doch nicht möglich ist bitte eine Info denn dann muß ich versuchen mein Prog umzuschreieben was mich aber bestimmt 4 Wochen nerven kostet da ich kurz vor dem Ende bin.
Also BITTE helft mir
Gruß Rene

Bild

Betrifft: AW: Dateien verschieben und weiterzählen
von: Josef Ehrensberger
Geschrieben am: 16.02.2005 09:23:40
Hallo Rene!
Befinden sich in dem Verzeichnis mit den Dateien die kopiert werden sollen
nur die .txt und .ps Files, oder auch noch andere Dateien?

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Bild

Betrifft: AW: Dateien verschieben und weiterzählen
von: Rene
Geschrieben am: 16.02.2005 09:33:44
Hallo Josef,
Danke für deine Antwort. In dem Verzeichnis befinden sich nur die beiden Dateien ".txt und .ps".
Gruß Rene
Bild

Betrifft: AW: Dateien verschieben und weiterzählen
von: Josef Ehrensberger
Geschrieben am: 16.02.2005 10:18:44
Hallo Rene!
Kopiere den Code in ein allgemeines Modul.
Bevor du den Code startest, musst du unter Extras > Verweise,
den Verweis auf "Microsoft Shell Controls And Automation" setzen!
Das Quellverzeichnis ist im Code fest vorgegeben.
Das Zielverzeichnis wird über einen Dialog ausgewählt.
Dabei kannst du auch neue Ordner anlegen!
Viel Spass!


      
'Created By Chip Pearson and Pearson Software Consulting Services
'\'a9 Copyright 1997-2003 Charles H. Pearson
' http://www.cpearson.com/excel/BrowseFolder.htm
Option Explicit
'Using the Shell Controls Library
'
'First you need to set a reference to the "Microsoft Shell
'Controls And Automation" object library.
'In the VBA Editor, go to the Tools menu, choose References,
'and scroll down to this item and put a check next to it.
'
'Then, copy the following code to a standard code module:
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
   
Function BrowseFolder(Optional Caption As String, _
   
Optional InitialFolder As StringAs String
   
Dim SH As Shell32.Shell
   
Dim F As Shell32.Folder
   
Set SH = New Shell32.Shell
   
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, _
   InitialFolder)
   
If Not F Is Nothing Then
      BrowseFolder = F.Items.Item.Path
   
End If
End Function
   
Sub kopiereDateien()
'by J.Ehrensberger
Dim objFSO As Object
Dim fSearch As FileSearch
Dim srcPath As String, tarPath As String, srcFile As String, tarFile As String
Dim txtCount As Integer, psCount As Integer, fCount As Integer
srcPath = 
"D:\Temp"  'Quellverzeichnis

tarPath = BrowseFolder(
"Order wählen""D:\Temp")  'Zielverzeichnis

If tarPath = "" Then Exit Sub
Set fSearch = Application.FileSearch
With fSearch
'ermitteln der Anzahl von *.txt - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = 
False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.Filename = 
"*.txt"
.Execute
txtCount = .FoundFiles.Count
'ermitteln der Anzahl von *.ps - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = 
False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.Filename = 
"*.ps"
.Execute
psCount = .FoundFiles.Count
'Auslesen des Quellordners
.NewSearch
.LookIn = srcPath
.SearchSubFolders = 
False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.Execute

Set objFSO = CreateObject("Scripting.FileSystemObject")

   
For fCount = 1 To .FoundFiles.Count
   
      
If Right(.FoundFiles(fCount), 3) = "txt" Then
      
         
'txt-File kopieren und umbenennen
         srcFile = .FoundFiles(fCount)
         
         tarFile = tarPath & 
"\" & Format(txtCount, "000") & ".txt"
         
         objFSO.CopyFile srcFile, tarFile
         
         txtCount = txtCount + 1
      
      
ElseIf Right(.FoundFiles(fCount), 2) = "ps" Then
      
         
'ps-File kopieren und umbenennen
         srcFile = .FoundFiles(fCount)
         
         tarFile = tarPath & 
"\" & Format(psCount, "000") & ".ps"
         
         objFSO.CopyFile srcFile, tarFile
         
         psCount = psCount + 1
      
      
End If
   
   
Next
End With
Set objFSO = Nothing
Set fSearch = Nothing
End Sub 

     Code eingefügt mit Syntaxhighlighter 3.0


Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Bild

Betrifft: AW: Dateien verschieben und weiterzählen
von: Rene
Geschrieben am: 16.02.2005 10:56:17
Hallo Sepp,
Danke dir schon mal für deine Mühe, habe ihn auch gleich ausprobiert aber leider sagt er mir "Benutzerdifinierter Typ nicht definiert" und markiert diese Zeile:
Function BrowseFolder(Optional Caption As String, _
Optional InitialFolder As String) As String
Dim SH As shell32.Shell
Weißt du Rat?
Gruß rene
Bild

Betrifft: AW: Dateien verschieben und weiterzählen
von: Rene
Geschrieben am: 16.02.2005 11:00:41
Hallo Sepp,
Habe natürlich den Verweiß nicht aktiviert, teste nun weiter und melde mich gleich.
Sorry noch mal für meine Dümmlichkeit.
Gruß rene
Bild

Betrifft: AW: Dateien verschieben und weiterzählen
von: Rene
Geschrieben am: 16.02.2005 11:32:15
Hallo Sepp,
Hurra ich bin total begeistert von dem Code klappt alles bestens, kannst du mir nur noch sagen wenn ich den Dateien einen Namen geben würde wollen Bsp."Mp000.txt und so weiter wo ich das mit einfügen müßte? Könnte es sein das es in diese Zeile:
tarFile = tarPath & "\" & Format(txtCount, "000") & ".txt" mit rein muß?
Gruß Rene
Bild

Betrifft: AW: Dateien verschieben und weiterzählen
von: Rene
Geschrieben am: 16.02.2005 11:43:29
Hallo Sepp,
Habe das eben selber mal ausprobiert und es ist so habe nun in die Zeile:" tarFile = tarPath & "\Mp" & Format(txtCount, "000") & ".txt" " eingetragen und es geht alles bestens. Den Verweis Microsoft Shell..... ist der eigentlich auf jedem Rechner aktiv oder muß ich das dann irgend wie erst aktivieren? Ich wollte das auch das Prog auf anderen Rechnern läuft.
Ich danke dir noch mal für deine Mühe hätte ich nie rausbekommen.
Gruß Rene
Bild

Betrifft: AW: Dateien verschieben und weiterzählen
von: Josef Ehrensberger
Geschrieben am: 16.02.2005 15:39:41
Hallo Rene!
Freud mich das es klappt!
Der Code sollte auf jedem anderen Rechner laufen.

Gruß Sepp
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Dateien verschieben und weiterzählen"