Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
608to612
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
608to612
608to612
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Laufzeitfehler??? (kann J.Ehrensberger helfen?)

Laufzeitfehler? (kann J.Ehrensberger helfen?)
07.05.2005 23:02:51
Rene
Moin zusammen,
Habe von J.Ehrensberger diesen Code bekommen:( Danke nochmal dafür)

Sub DQM_und_PS_Dateien_verschieben()
'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 dqmCount As Integer, psCount As Integer, fCount As Integer
srcPath = "C:\DQM\Messung"  'Quellverzeichnis
tarPath = BrowseFolder("Order wählen", "C:\DQM\Messung\2005")  'Zielverzeichnis
If tarPath = "" Then Exit Sub
Set fSearch = Application.FileSearch
With fSearch
'ermitteln der Anzahl von *.dqm - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.Filename = "*.dqm"
.Execute
dqmCount = .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) = "dqm" Then
'dqm-File verschieben und umbenennen
srcFile = .FoundFiles(fCount)
tarFile = tarPath & "\Mp" & Format(dqmCount, "000") & ".dqm"
objFSO.MoveFile srcFile, tarFile
dqmCount = dqmCount + 1
ElseIf Right(.FoundFiles(fCount), 2) = "ps" Then
'ps-File verschieben und umbenennen
srcFile = .FoundFiles(fCount)
tarFile = tarPath & "\Mp" & Format(psCount, "000") & ".ps"
objFSO.MoveFile srcFile, tarFile
psCount = psCount + 1
End If
Next
End With
Set objFSO = Nothing
Set fSearch = Nothing
End Sub

Habe ihn dann nur noch für meine Dateien angepaßt er geht auch soweit prima nur das er mir nicht immer die Dateien verschiebt entweder gibt er mir Datei existiert bereits oder Datei nicht vorhanden. Kann mir einer dabei helfen wie dieses Zustande kommt? Das merkwürdige ist auserdem das wenn ich eigentlich mit 000 anfangen will er einfach mit 239(238 würde in einem anderen Ordner die letzte Nummer gewesen sein)als ob er die Zahlen irgendwo speichert und dann weiterzählen will.Hoffe das mir einer oder sogar Josef E. helfen kann.
mfg Rene

33
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Laufzeitfehler? (kann J.Ehrensberger helfen?
08.05.2005 00:39:22
Ramses
Hallo
Der Code zählt am Anfang wiewiele der jeweiligen Dateien bereits vorhanden sind
dqmCount = .FoundFiles.Count
bzw.
psCount = .FoundFiles.Count
und nimmt das als neuen Zähler.
Offensichtlich ist hier eine Inhomogenität aufgetreten und der Zähler stimmt deshalb nicht mehr.
Wie der Fehler bereits sagt, dann existiert eine Datei mit dem gleichen Namen bereits im Zielordner
objFSO.MoveFile srcFile, tarFile
Wenn die Datei am Zielort bereits besteht, klappt es halt nicht.
Da musst du wohl im Zielordner aufräumen bzw. die Dateien umbenennen
Gruss Rainer
Gruss Rainer
Anzeige
Super, danke Hajo...mot
08.05.2005 02:05:37
Rehne
Kein Text
AW: Laufzeitfehler? (kann J.Ehrensberger helfen?
08.05.2005 09:43:30
Rene
Hi Ramses,
Möchte mich erst mal entschuldigen das ich dir erst jetzt antworte habe aber die letzten Tage so viel vor dem Rechner gesessen das ich gestern bei Zeiten ins Bett mußte sonst wäre ich abgeklappt.
Nun noch mal zu meinem Problem, das merkwürdige ist ja aber das es bis zu einem bestimmten Zähler prima geht dann kommt wieder mal entweder der LfZ Datei existiert oder nicht vorhanden aber irgendwann geht es mal wieder für ein paar Zahlen. Dann hast du einen Begriff genommen den ich nicht mal aussprechen kann " Inhomogenität " was ist dieses?
Die Dateien können eigentlich gar nicht schon bestehen, weil sie ja immer fortlaufend weitergezählt werden sollen.Hier mal ein Bsp.
Im Ordner C:\Test\ liegen die Dateien 000.ps....034.ps diese werden nun über das Ordnerauswahlmenü in einen Ordner eigener Wahl verschoben.Geht auch super.Nun liegen im Ordner C:\Test\ wieder Dateien 000.ps....067.ps drin diese sollen wieder über das Ordnerauswahlmenü in den gleichen Ordner wo schon die andern drin sind verschoben werden,und nun kommt der Knackpunkt die zweiten Dateien müßten ja nun nicht mehr 000.ps...067.ps heißen sondern sollen ja weitergezählt werden also 035.ps....101.ps, so und dieses macht er ab und zu aber meistens gibt er dann Lfz Fehler.Da ich aber diese Dateien immer weiterzählen müßte kann ich da nicht aufräumen oder umbennen. Gibt es dafür einen Grund oder Möglichkeit dieses zu beheben.
Gruß Rene
Anzeige
AW: Laufzeitfehler? (kann J.Ehrensberger helfen?
08.05.2005 10:03:55
Rene
Hi nochmal,
Habe es eben nochmal getestet und ich konnte ein paar mal die Dateien verschieben bin dann bei 167 angekommen dann wollte ich die nächsten Dateien verschieben und dann kam der Fehler nicht gefunden,aber er hat mir die letzten Dateien verschoben und weitergezählt(was auch schlecht ist weil diese dann nicht mehr der Reihenfolge wären und meine gesp.Dateien durcheinander kommen)Dann habe ich die letzten gelöscht und nochmal getestet und nun geht es wieder bis zum nächsten LFZ. Keine Ahnung woran das liegen kann.Bitte helft mir.
mfg Rene
AW: Laufzeitfehler? (kann J.Ehrensberger helfen?
08.05.2005 10:48:50
Ramses
Hallo
Ich habe keine Ahnung was bei Dir auf dem Rechner los ist, und mit diesen Informationen kann ich auch nicht viel anfangen.
Wenn es bei wiederholten Verschiebungen zum Problem kommt, probier mal die fett markierten Änderungen
With fSearch
'ermitteln der Anzahl von *.dqm - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
.Filename = "*.dqm"
.Execute
dqmCount = .FoundFiles.Count + 1
'ermitteln der Anzahl von *.ps - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
.Filename = "*.ps"
.Execute
psCount = .FoundFiles.Count + 1
Da Josef beim Starten die Anzahl der bestehenden Dateien prüft, könnte hier das problem liegen, weil er mit der gleichen Nummer psCount startet, wie die Anzahl der Dateien ist. Ich gehe nun davon aus, dass zumindest die letzte Datei im neuen Kopiervorgang dann schon existiert. Vielleicht ist das der Fehler
Gruss Rainer
Anzeige
AW: Laufzeitfehler? (kann J.Ehrensberger helfen?
08.05.2005 12:01:52
Rene
Hi Ramses,
Habe deinen Vorschlag probiert und es geht auch nicht richtig er gibt mir auch wieder einen Lf Fehler.Nun hatte ich ja mal die Ordner gelehrt und von vorne angefangen also alles leer,dabei ist mir jetzt aufgefallen wenn ich mich im Debug Modus(wenn der Fehler wieder kommt) befinde dann markiert er mir ja die Zeile " objFSO.MoveFile srcFile, tarFile" wenn ich nun auf ".FoundFiles.Count" gehe dann zeigt er mir die Zahl 334(Beispiel) an was mir sagt das er da weiter zählen würde wollen,aber in dem neuen Ordner sind ja noch gar keine Dateien drin! Also muß er ja den Zielordner gar nicht überprüfen sonst würde er ja nicht die Zahl 334(Beispiel) anzeigen.Hast du da ne Idee was dieses sein Könnte?
gruß Rene
Anzeige
AW: Laufzeitfehler? (kann J.Ehrensberger helfen?
08.05.2005 13:02:58
Ramses
Hallo
.FoundFiles.Count
bezieht sich auf die Anzahl der gefundenen Dateien im Quell-Ordner, nicht im Zielordner.
Eventuell ist dort der Knackpunkt, weil hier alle Dateien für die Schleife gezählt werden, aber nicht entsprechend viele "dqm" und "ps" Dateien vorhanden sind.
Schick mir mal die Funktion "BrowseFolder" mit den Deklarationen die Josef mitgeschickt hat.
Sonst muss ich die nachbauen.
Ich bau dir dann eine neue Prozedur, welche diesen Umstand berücksichtigt.
Gruss Rainer
AW: Laufzeitfehler? (kann J.Ehrensberger helfen?
08.05.2005 13:42:47
Rene
Hi Ramses,
Ich denke auch das du Recht hast, weil er wirklich alle Dateien zählt die im Ordner sind, wenn ich im Debug Mod bin und die Zeile " objFSO.MoveFile srcFile, tarFile" gelb ist und ich dann auf "srcFile = .FoundFiles(fCount)" gehe, dann zeigt er mir auch immer nur dqm Dateien an egal ob bei dqm oder ps. Ok hier ist mal der ganze Code von Josef ich hoffe du kannst damit etwas anfangen und ihn rep. vielleicht könntest du mir auch noch den gefallen tun und die Option mit in Erwägung ziehen das der Ordner den man zuletzt ausgewählt hat offen bleibt. Ich muß bis jetzt bei jeder Auswahl den Ordner neu öffnen obwohl ich den gleichen haben möchte. Wäre prima wenn du auch dafür eine Lösung finden würdest.
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 String) As 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 DQM_und_PS_Dateien_verschieben()
'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 dqmCount As Integer, psCount As Integer, fCount As Integer
srcPath = "C:\DQM\Messung"  'Quellverzeichnis
tarPath = BrowseFolder("Order wählen", "C:\DQM\Messung\2005")  'Zielverzeichnis
If tarPath = "" Then Exit Sub
Set fSearch = Application.FileSearch
With fSearch
'ermitteln der Anzahl von *.dqm - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.Filename = "*.dqm"
.Execute
dqmCount = .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) = "dqm" Then
'dqm-File verschieben und umbenennen
srcFile = .FoundFiles(fCount)
tarFile = tarPath & "\Mp" & Format(dqmCount, "000") & ".dqm"
objFSO.MoveFile srcFile, tarFile
dqmCount = dqmCount + 1
ElseIf Right(.FoundFiles(fCount), 2) = "ps" Then
'ps-File verschieben und umbenennen
srcFile = .FoundFiles(fCount)
tarFile = tarPath & "\Mp" & Format(psCount, "000") & ".ps"
objFSO.MoveFile srcFile, tarFile
psCount = psCount + 1
End If
Next
End With
Set objFSO = Nothing
Set fSearch = Nothing
End Sub

Danke schon mal im vorraus,
Bis denne Rene
Anzeige
Neuer Code
08.05.2005 15:29:54
Ramses
Hallo
Hab das ganze mal etwas umgebschrieben und die Speicherorte gleich mit aufgenommen.
Diese müssen zwar noch bestätigt werden, sollte aber prinzipiell möglich sein.
Um einen neuen Zielordner in deinem Basisverzeichnis anlegen willst, musst du bei der entsprechenden Dialogabfrage auf "Abbrechen" klicken.
In der Datei "C:\LastFolder.ini" werden die ganzen Folder-Einstellungen gespeichert.
Option Explicit
'Variablen Deklaration
' Funktion um Einträge aus einer INI Datei zu Lesen
Private Declare

Function ReadINIString Lib "kernel32" _
Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault$, _
ByVal lpReturnedString$, ByVal nSize As Long, _
ByVal lpFileName$) As Long
' Funktion, um Einträge in eine INI Datei zu schreiben
Private Declare 

Function WriteINIString& Lib _
"kernel32" Alias "WritePrivateProfileStringA" _
(ByVal AppName$, ByVal KeyName$, _
ByVal keydefault$, ByVal FileName$)
'Einstellungen der letzten Ordner werden hier gespeichert
Private Const INI_File = "c:\LastFolder.ini"
'Einstellungen der letzten Ordner werden in diesen Section's gespeichert
Private Const LastFolder As String = "LastFolder"
Private Const BaseFolder As String = "BaseFolder"

Function SaveMyFolder(mysection As String, newFolder As String)
'1. Zuletzt verwendeten Ordner speichern
WriteINIString mysection, mysection, newFolder, INI_File
End Function


Function GetMyFolder(mysection As String, LastFolder As String) As String
Dim tmpRead As String
'Variablengrösse bestimmen
'255 Zeichen lang
tmpRead = String(255, 0)
ReadINIString mysection, LastFolder, vbNullString, tmpRead, 255, INI_File
GetMyFolder = Left$(tmpRead, InStr(1, tmpRead, Chr(0)) - 1)
End Function


Sub Rename_and_MoveFiles()
'(C) Ramses
'Verschiebt alle DQM und PS Dateien in einem Ordner
'in einen Zielordner und nummeriert diese neu
Dim tmpName As String, tarName As String, tarPath As String, srcPath As String
Dim myFSO As Object, myFld As Object, myFldFiles As Object, myFile As Object
Dim objFolder As Object, objFolderItem As Object, objShell As Object
Dim psCount As Integer, dqmCount As Integer, dqmCounter As Integer, psCounter As Integer
Dim Qe As Integer
Dim fSearch As FileSearch
Dim myErr As Integer
'ErrorHandler starten
'On Error GoTo myErrorHandler
'Erstellen des FileSystemObjectes
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
'Quellordner bestätigen
Set objFolder = objShell.BrowseForFolder(0&, "Quell Ordner auswählen...", 0&, GetMyFolder(BaseFolder, BaseFolder))
If objFolder Is Nothing Then Exit Sub
Set objFolderItem = objFolder.Self
srcPath = objFolderItem.Path
If Not myFSO.folderexists(srcPath) Then
MsgBox "Der Ordner :"" " & srcPath & " "" existiert nicht.", vbCritical + vbOKOnly, "Abbruch"
Exit Sub
End If
'Wenn neuer Quellordner definiert wurde diesen speichern
If srcPath <> GetMyFolder(BaseFolder, BaseFolder) Then
SaveMyFolder BaseFolder, srcPath
End If
'Zielordner auswählen
Set objFolder = objShell.BrowseForFolder(0&, "Ziel Ordner auswählen...", 0&, GetMyFolder(LastFolder, LastFolder))
If objFolder Is Nothing Then
'Bei Abbrechen !!!! wenn neuer Zielordner im Basisfolder erstellt werden soll !!!
Qe = MsgBox("Möchten Sie einen neuen Zielordner erstellen ?", vbQuestion + vbYesNo, "Ziel ändern ?")
If Qe = vbYes Then
Set objFolder = objShell.BrowseForFolder(0&, "Ziel Ordner auswählen...", 0&, GetMyFolder(BaseFolder, BaseFolder))
If objFolder Is Nothing Then Exit Sub
Else
Exit Sub
End If
End If
Set objFolderItem = objFolder.Self
tarPath = objFolderItem.Path
If Not myFSO.folderexists(tarPath) Then
MsgBox "Der Ordner :"" " & tarPath & " "" existiert nicht.", vbCritical + vbOKOnly, "Abbruch"
Exit Sub
End If
'Wenn neuer Zielordner definiert wurde diesen speichern
If tarPath <> GetMyFolder(LastFolder, LastFolder) Then
SaveMyFolder LastFolder, tarPath
End If
'File Search Initialisieren um die Anzahl Dateien zu bestimmen
Set fSearch = Application.FileSearch
With fSearch
'ermitteln der Anzahl von *.dqm - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.FileName = "*.dqm"
.Execute
dqmCount = .FoundFiles.Count + 1
'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 + 1
End With
'Move Schleife starten
'Zuweisen des Quellpfades wo die Dateien herkommen
Set myFld = myFSO.GetFolder(srcPath)
'Zuweisund der Dateien in diesem Ordner
Set myFldFiles = myFld.Files
For Each myFile In myFldFiles
tmpName = myFile.Name
'Das INI File vom Kopiervorgang ausschliessen
'INI_File ist die globale Variable !!!
If Right(tmpName, 3) <> "ini" Then
If Right(tmpName, 3) = "dqm" Then
tarName = tarPath & "\Mp" & Format(dqmCount, "000") & ".dqm"
'DQM Zähler hochsetzen
dqmCounter = dqmCounter + 1
dqmCount = dqmCount + 1
ElseIf Right(tmpName, 2) = "ps" Then
tarName = tarPath & "\Mp" & Format(psCount, "000") & ".ps"
'PS Zähler hochsetzen
psCounter = psCounter + 1
psCount = psCount + 1
End If
myFSO.MoveFile myFile, tarName
End If
MoveRestart:
Next
MsgBox "Es wurden "" " & dqmCounter & " dqm-Files "" und "" " & Chr$(13) & _
psCounter & " ps-Files "" Dateien verschoben"
'Fehlerbehandlung Ende
myErrorExit:
Exit Sub
'Fehlerbehandlung starten
myErrorHandler:
Select Case Err
Case 58
Qe = MsgBox("Die Datei "" " & myFile & " "" mit dem neuen Namen: "" " & tarName & _
" "" existiert bereits im Folder " & tarPath & Chr$(13) & _
"Soll das Makro abgebrochen werden ?" & Chr$(13) & _
"Bei NEIN wird versucht die restlichen Dateien zu verschieben ?! ", _
vbCritical + vbYesNoCancel, "Doppelte Datei")
If Qe = vbYes Then
MsgBox "Makro wird abgebrochen"
Resume myErrorExit
Exit Sub
End If
Case Else
MsgBox Err.Number & ": " & Err.Description, vbCritical + vbOKOnly, "Unerwarteter Fehler  >  Abbruch File-Move Action"
Resume myErrorExit
End Select
End Sub

Habe das ganze mal mehrfach mit ein paar hundert Dateien probiert und funktioniert problemlos.
Gruss Rainer
Anzeige
Zusätzliche Info...
08.05.2005 15:33:54
Ramses
Hallo
irgendwie geht das Editieren nicht :-)
Den ganzen Code in ein Modul kopieren
Die Erste Code Zeile muss in einer Zeile stehen
Private Declare Function ReadINIString Lib "kernel32"
Zusätzliche Verweise sind mir gerade nicht bekannt.
Einfach mal probieren
Gruss Rainer
Gruss Rainer
AW: Zusätzliche Info...
08.05.2005 15:40:35
Rene
Hi Rainer,
Gott oh Gott da hast du dir aber eine Menge Arbeit gemacht, danke dir schon mal tausendfach dafür,kann es aber leider erst heute Abend testen da ich jetzt zum Nationalfeiertag meiner Mutter muß, würde mich dann heute Abend noch mal melden ich hoffe das geht i.o.
Gruß Rene
Anzeige
Nochmals Info...
08.05.2005 15:46:38
Ramses
Hallo
du musst noch eine Zeile hinzufügen, die habe ich vergessen :-)
If Qe = vbYes Then
MsgBox "Makro wird abgebrochen"
Resume myErrorExit
Exit Sub
End If
Resume MoveRestart
Case Else
Gruss Rainer
AW: Zusätzliche Info...
08.05.2005 18:25:08
Rene
Hi Rainer,
Wollte nun den Code von dir mal testen aber leider bekomme ich es nicht hin. Habe es so geschrieben:
Private DeclareFunction ReadINIString Lib "kernel32" _
Dann gibt er mir aber Fehler beim kompilieren und markiert ReadINIString weißt du zufällig Rat?
gruß Rene
Anzeige
AW: Zusätzliche Info...
08.05.2005 18:35:02
Rene
Hi Rainer,
Ich nochmal ich Idiot habe die Zeile "Private DeclareFunction ReadINIString Lib "kernel32" _" so geschrieben und nicht "Declare Function" nun habe ich deinen zweiten Fehler in der Zeile geändert die schon da war (hoffe das das richtig ist) und teste mal weiter melde mich gleich.
gruß Rene
AW: Zusätzliche Info...
08.05.2005 19:21:59
Rene
Hallo Rainer,
Ich bin von deiner Arbeit begeistert ich habe es auch getestet und es lief wirklich immer durch. In dem Code hast du die Error Anweißung nicht angegeben "'On Error GoTo myErrorHandler" ist das gewollt oder unabsichtlich gewesen? Habe dann noch eine Frage da der Quellordner immer der gleiche ist ob mann diesen auch nicht wieder vorgeben kann("C:\DQM\Messung) mann hätte dann eine Abfrage weniger? Wäre prima wenn diese gehen würde ansonsten DANKE ICH DIR TAUSEND MAL
gruß Rene
Anzeige
Ich glaub es nicht!!!!!!
08.05.2005 19:59:52
Rene
Hi Rainer,
Nun verstehe ich die Welt gar nicht mehr habe das ganze auf meinem normalen PC getestet und soweit alles prima, nun habe ich das auf meinem Notebook drauf gemacht und da kommt auf einmal die Error Anweißung die du gemacht hast. Habe dann einen neuen Zielordner ausgewählt und da kommt eine Fehlermeldung die ich noch nie hatte. "5:Ungültiger Prozeduraufruf oder ungültiges Argument" liegt das etwa an meinem Notebook? :(
gruß Rene
AW: Ich glaub es nicht!!!!!!
08.05.2005 20:03:18
Ramses
Hallo
die "On Error Anweisung " hatte ich tatsächlich vergessen zu aktivieren :-)
Testen tu ich immer ohne Errorhandler :-)
Danke für den Pre-Tip an Reinhard ;-)

Option Explicit
'Variablen Deklaration
' Funktion um Einträge aus einer INI Datei zu Lesen
Private Declare Function ReadINIString Lib "kernel32" _
Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault$, _
ByVal lpReturnedString$, ByVal nSize As Long, _
ByVal lpFileName$) As Long
' Funktion, um Einträge in eine INI Datei zu schreiben
Private Declare Function WriteINIString& Lib _
"kernel32" Alias "WritePrivateProfileStringA" _
(ByVal AppName$, ByVal KeyName$, _
ByVal keydefault$, ByVal FileName$)
'Einstellungen der letzten Ordner werden hier gespeichert
Private Const INI_File = "c:\LastFolder.ini"
'Einstellungen des zuletzt geöffneten ZielOrdner
'wird in dieser Section gespeichert
Private Const LastFolder As String = "LastFolder"
Private Const BaseFolder As String = "C:\DQM\"
Function SaveMyFolder(mysection As String, newFolder As String)
'1. Zuletzt verwendeten Ordner speichern
WriteINIString mysection, mysection, newFolder, INI_File
End Function
Function GetMyFolder(mysection As String, LastFolder As String) As String
Dim tmpRead As String
'Variablengrösse bestimmen
'255 Zeichen lang
tmpRead = String(255, 0)
ReadINIString mysection, LastFolder, vbNullString, tmpRead, 255, INI_File
GetMyFolder = Left$(tmpRead, InStr(1, tmpRead, Chr(0)) - 1)
End Function
Sub Rename_and_MoveFiles()
'(C) Ramses
'Verschiebt alle DQM und PS Dateien in einem Ordner
'in einen Zielordner und nummeriert diese neu
'Die Einstellungen BaseFolder und LastFolder werden in einer INI-Datei gespeichert
Dim tmpName As String, tarName As String, tarPath As String
Dim myFSO As Object, myFld As Object, myFldFiles As Object, myFile As Object
Dim objFolder As Object, objFolderItem As Object, objShell As Object
Dim psCount As Integer, dqmCount As Integer, dqmCounter As Integer, psCounter As Integer
Dim Qe As Integer
Dim fSearch As FileSearch
'ErrorHandler starten
On Error GoTo myErrorHandler
'Erstellen des FileSystemObjectes
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
'Zielordner auswählen
Set objFolder = objShell.BrowseForFolder(0&, "Ziel Ordner auswählen... " & Chr$(13) & _
"""Abbrechen"" um neuen Zielordner im Basisverzeichnis: " & Chr$(13) & BaseFolder & " zu erstellen!", 0&, GetMyFolder(LastFolder, LastFolder))
If objFolder Is Nothing Then
'Bei Abbrechen !!!! wenn neuer Zielordner im Basisfolder erstellt werden soll !!!
Qe = MsgBox("Möchten Sie einen neuen Zielordner erstellen ?", vbQuestion + vbYesNo, "Ziel ändern ?")
If Qe = vbYes Then
Set objFolder = objShell.BrowseForFolder(0&, "Ziel Ordner erstellen... ", 0&, BaseFolder)
If objFolder Is Nothing Then Exit Sub
Else
Exit Sub
End If
End If
Set objFolderItem = objFolder.Self
tarPath = objFolderItem.Path
If Not myFSO.folderexists(tarPath) Then
MsgBox "Der Ordner :"" " & tarPath & " "" existiert nicht.", vbCritical + vbOKOnly, "Abbruch"
Exit Sub
End If
'Wenn neuer Zielordner definiert wurde diesen speichern
If tarPath <> GetMyFolder(LastFolder, LastFolder) Then
SaveMyFolder LastFolder, tarPath
End If
'File Search Initialisieren um die Anzahl Dateien zu bestimmen
Set fSearch = Application.FileSearch
With fSearch
'ermitteln der Anzahl von *.dqm - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.FileName = "*.dqm"
.Execute
dqmCount = .FoundFiles.Count + 1
'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 + 1
End With
'Move Schleife starten
'Zuweisen des Quellpfades wo die Dateien herkommen
Set myFld = myFSO.GetFolder(BaseFolder)
'Zuweisund der Dateien in diesem Ordner
Set myFldFiles = myFld.Files
For Each myFile In myFldFiles
tmpName = myFile.Name
'Das INI File vom Kopiervorgang ausschliessen
'INI_File ist die globale Variable !!!
If Right(tmpName, 3) <> "ini" Then
If Right(tmpName, 3) = "dqm" Then
tarName = tarPath & "\Mp" & Format(dqmCount, "000") & ".dqm"
'DQM Zähler hochsetzen
dqmCounter = dqmCounter + 1
dqmCount = dqmCount + 1
ElseIf Right(tmpName, 2) = "ps" Then
tarName = tarPath & "\Mp" & Format(psCount, "000") & ".ps"
'PS Zähler hochsetzen
psCounter = psCounter + 1
psCount = psCount + 1
End If
myFSO.MoveFile myFile, tarName
End If
MoveRestart:
Next
MsgBox "Es wurden "" " & dqmCounter & " dqm-Files "" und "" " & Chr$(13) & _
psCounter & " ps-Files "" Dateien verschoben"
'Fehlerbehandlung Ende
myErrorExit:
Exit Sub
'Fehlerbehandlung starten
myErrorHandler:
Select Case Err
Case 58
Qe = MsgBox("Die Datei "" " & myFile & " "" mit dem neuen Namen: "" " & tarName & _
" "" existiert bereits im Folder " & tarPath & Chr$(13) & _
"Soll das Makro abgebrochen werden ?" & Chr$(13) & _
"Bei NEIN wird versucht die restlichen Dateien zu verschieben ?! ", _
vbCritical + vbYesNoCancel, "Doppelte Datei")
If Qe = vbYes Then
MsgBox "Makro wird abgebrochen"
Resume myErrorExit
Exit Sub
End If
Case Else
MsgBox Err.Number & ": " & Err.Description, vbCritical + vbOKOnly, "Unerwarteter Fehler  >  Abbruch File-Move Action"
Resume myErrorExit
End Select
End Sub

Woran der Fehler liegt kann ich dir jetzt noch nicht sagen.
Schalte mal den Error-Handler wieder aus, und schau mal welche Zeile er markiert.
Eventuell fehlt ein Verweis
Gruss Rainer
AW: Ich glaub es nicht!!!!!!
08.05.2005 20:19:24
Rene
Hi Rainer,
Habe nun den Code nochmal neu kopiert die Error Anweißung ausgeschaltet und er macht immer noch den Fehler markiert die Zeile " myFSO.MoveFile myFile, tarName" wenn ich nun auf den gelben Text gehe dann zeigt er mir "myFile = "C:\DQM\DOSRCA.exe" " dieses ist eine Datei die ich für ein Programm normaler Weise brauche verstehe aber gar nicht was das hiermit zutuen hat. Vorallen warum geht es auf dem anderen Rechner?
Gruß Rene
AW: Ich glaub es nicht!!!!!!
08.05.2005 20:23:25
Ramses
Hallo
so ganz erklären kann ich mir das nicht, warum es einmal funktioniert und das zweite mal micht, aber ändere mal die Zeile
If Right(tmpName, 3) "ini" Then
in
If Right(tmpName, 3) = "dqm" or Right(tmpName, 2) = "ps" Then
Dann haben wir zwar eine doppelte Abfrage, aber der Zähler für das Kopieren wird korrekt verwendet.
Gruss Rainer
AW: Ich glaub es nicht!!!!!!
08.05.2005 20:34:50
Rene
Hi Rainer,
Habe die Zeile geändert jetzt gibt er zwar nicht mehr die Fehlermeldung aber er verschiebt auch nichts mehr. Habe es auf dem normalen PC probiert da gibt er mir auch die Fehlermeldung (das ganze mit dem neuen Code) der allererste von dir läuft aber auf dem normalen PC ohne Probleme.
Gruß Rene
AW: Ich glaub es nicht!!!!!!
08.05.2005 20:47:51
Ramses
Hallo
Das ist nicht nachvollziehbar.
Der Code läuft bei mir einwandfrei durch und verhindert das kopieren/verschieben von anderen Dateien.
Lauten die Dateien auch wirklich gleich ?
Gruss Rainer
AW: Ich glaub es nicht!!!!!!
08.05.2005 21:39:11
Ramses
Hallo
Tut mir leid, in den Basisfunktionen sind beide gleich.
Hier nochmal der aktualisierte Code.
Wenn der nicht läuft, weiss ich auch nicht mehr weiter.
Wie gesagt ich habe das ganze jetzt mehrfach wiederholt mit unterschiedlichen Quell- aber gleichen Zielverzeichnis. Dort sind zwischenzeitlich 1500 Dateien, alle aus unterschiedlichen Quellverzeichnissen.
Der Code hat jedesmal problemlos funktioniert:

Option Explicit
'(C) Ramses
'Der gesamte Code gehört in ein Modul
'Variablen Deklaration
' Funktion um Einträge aus einer INI Datei zu Lesen
Private Declare Function ReadINIString Lib "kernel32" _
Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault$, _
ByVal lpReturnedString$, ByVal nSize As Long, _
ByVal lpFileName$) As Long
' Funktion, um Einträge in eine INI Datei zu schreiben
Private Declare Function WriteINIString& Lib _
"kernel32" Alias "WritePrivateProfileStringA" _
(ByVal AppName$, ByVal KeyName$, _
ByVal keydefault$, ByVal FileName$)
'Einstellungen der letzten Ordner werden hier gespeichert
Private Const INI_File = "c:\LastFolder.ini"
'Einstellungen der letzten Ordner werden in diesen
'INI-Section's gespeichert
Private Const LastFolder As String = "LastFolder"
'...oder als Konstante mit fester Pfadangabe
Private Const BaseFolder As String = "C:\DQM\"
Function SaveMyFolder(mysection As String, newFolder As String)
'1. Zuletzt verwendeten Ordner speichern
WriteINIString mysection, mysection, newFolder, INI_File
End Function
Function GetMyFolder(mysection As String, LastFolder As String) As String
Dim tmpRead As String
'Variablengrösse bestimmen
'255 Zeichen lang
tmpRead = String(255, 0)
ReadINIString mysection, LastFolder, vbNullString, tmpRead, 255, INI_File
GetMyFolder = Left$(tmpRead, InStr(1, tmpRead, Chr(0)) - 1)
End Function
Sub Rename_and_MoveFiles()
'(C) Ramses
'Verschiebt alle DQM und PS Dateien in einem Ordner
'in einen Zielordner und nummeriert diese neu
'Die Einstellungen BaseFolder und LastFolder werden in einer INI-Datei gespeichert
Dim tmpName As String, tarName As String, tarPath As String, srcPath As String
Dim myFSO As Object, myFld As Object, myFldFiles As Object, myFile As Object
Dim objFolder As Object, objFolderItem As Object, objShell As Object
Dim psCount As Integer, dqmCount As Integer, dqmCounter As Integer, psCounter As Integer
Dim Qe As Integer
Dim fSearch As FileSearch
Dim myErr As Integer
'ErrorHandler starten
'On Error GoTo myErrorHandler
'Erstellen des FileSystemObjectes
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
'Zielordner auswählen
Set objFolder = objShell.BrowseForFolder(0&, "Ziel Ordner auswählen...", 0&, GetMyFolder(LastFolder, LastFolder))
If objFolder Is Nothing Then
'Bei Abbrechen !!!! wenn neuer Zielordner im Basisfolder erstellt werden soll !!!
Qe = MsgBox("Möchten Sie einen neuen Zielordner erstellen ?", vbQuestion + vbYesNo, "Ziel ändern ?")
If Qe = vbYes Then
Set objFolder = objShell.BrowseForFolder(0&, "Ziel Ordner auswählen...", 0&, GetMyFolder(BaseFolder, BaseFolder))
If objFolder Is Nothing Then Exit Sub
Else
Exit Sub
End If
End If
Set objFolderItem = objFolder.Self
tarPath = objFolderItem.Path
If Not myFSO.folderexists(tarPath) Then
MsgBox "Der Ordner :"" " & tarPath & " "" existiert nicht.", vbCritical + vbOKOnly, "Abbruch"
Exit Sub
End If
'Wenn neuer Zielordner definiert wurde diesen speichern
If tarPath <> GetMyFolder(LastFolder, LastFolder) Then
SaveMyFolder LastFolder, tarPath
End If
'File Search Initialisieren um die Anzahl Dateien zu bestimmen
Set fSearch = Application.FileSearch
With fSearch
'ermitteln der Anzahl von *.dqm - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.FileName = "*.dqm"
.Execute
dqmCount = .FoundFiles.Count + 1
'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 + 1
End With
'Move Schleife starten
'Bei Verwendung der Konstanten BaseFolder
Set myFld = myFSO.GetFolder(BaseFolder)
'Zuweisung der Dateien in diesem Ordner
Set myFldFiles = myFld.Files
For Each myFile In myFldFiles
tmpName = myFile.Name
'Das INI File vom Kopiervorgang ausschliessen
'INI_File ist die globale Variable !!!
If Right(tmpName, 3) = "dqm" Or Right(tmpName, 2) = "ps" Then
If Right(tmpName, 3) = "dqm" Then
tarName = tarPath & "\Mp" & Format(dqmCount, "000") & ".dqm"
'DQM Zähler hochsetzen
dqmCounter = dqmCounter + 1
dqmCount = dqmCount + 1
ElseIf Right(tmpName, 2) = "ps" Then
tarName = tarPath & "\Mp" & Format(psCount, "000") & ".ps"
'PS Zähler hochsetzen
psCounter = psCounter + 1
psCount = psCount + 1
End If
myFSO.MoveFile myFile, tarName
End If
MoveRestart:
Next
MsgBox "Es wurden "" " & dqmCounter & " dqm-Files "" und "" " & Chr$(13) & _
psCounter & " ps-Files "" Dateien verschoben"
'Fehlerbehandlung Ende
myErrorExit:
Exit Sub
'Fehlerbehandlung starten
myErrorHandler:
Select Case Err
Case 58
Qe = MsgBox("Die Datei "" " & myFile & " "" mit dem neuen Namen: "" " & tarName & _
" "" existiert bereits im Folder " & tarPath & Chr$(13) & _
"Soll das Makro abgebrochen werden ?" & Chr$(13) & _
"Bei NEIN wird versucht die restlichen Dateien zu verschieben ?! ", _
vbCritical + vbYesNoCancel, "Doppelte Datei")
If Qe = vbYes Then
MsgBox "Makro wird abgebrochen"
Resume myErrorExit
Exit Sub
End If
Resume MoveRestart
Case Else
MsgBox Err.Number & ": " & Err.Description, vbCritical + vbOKOnly, "Unerwarteter Fehler  >  Abbruch File-Move Action"
Resume myErrorExit
End Select
End Sub

Gruss Rainer
AW: Ich glaub es nicht!!!!!!
08.05.2005 21:49:55
Rene
Hi Rainer,
Der Code gibt mir zwar keinen Fehler mehr aber er verschiebt mir keine Dateien obwohl welche im Ordner Messungen liegen. Es kommt die MsgBox "Es wurden 0 dqm dateien und 0 ps Dateien verschoben"
Gruß Rene
Noch offen...
08.05.2005 22:07:37
Ramses
Hallo
Tut mir leid.
Ich gebe auf. Ich kann nicht auf deinen Rechner sehen.
Bei mir läuft der Code einwandfrei und ohne Probleme. Wie gesagt, ich habe das ganze nun mit knapp 1500 Dateien getestet.
Probier mal die Datei "C:\LastFolder.ini" zu löschen und starte den Code neu.
Wenn es dann nicht funktioniert weiss ich auch nicht mehr weiter.
Gruss Rainer
Ich habs!!!
08.05.2005 22:20:58
Rene
Hi Rainer,
Die Zeile "Private Const BaseFolder As String = "C:\DQM\"" war nicht richtig da fehlte der Ordner Messung.Die Zeile habe ich geändert in "Private Const BaseFolder As String = "C:\DQM\Messung" " und auf dem normalen PC läuft es. Warum es nun aber auf meinem Notebook nicht geht weiß ich auch nicht.
Könntest du mir nun mal noch sagen was man machen müßte um den Ordner Messung als Standard zu definieren das nicht die Abfrage nach dem Quellordener kommt denn dieser ist immer gleich. Aber das allese natürlich nur wenn du noch Lust und die Nerven dazu hast.
Gruß Rene
Nun läuft es!!!
08.05.2005 22:36:50
Rene
Hi Rainer,
Also ich hab es nun so das es überall läuft das die Abfrage nach dem Quellordner schon weg ist ist mir leider erst jetzt aufgefallen. Also nun sieht es so aus als wenn alles prima läuft Ich danke dir noch mal für dein Verständins deine Hilfe und deine Ruhe.
Gruß Rene
Endlich :-) ,...Schönen Abend noch. o.T.
08.05.2005 22:52:44
Ramses
...
AW: Ich habs!!!
08.05.2005 22:39:33
Ramses
Hallo
Hier die Variante mit der fixen Einstellung, zusätzlich noch mit einer Prüfung, wenn der Quell- und Zielordner identisch sind.
Schau mal ob auf deinem Notebook die Gross- und Kleinschreibung des Ordners übereinstimmt.

Option Explicit
'(C) Ramses
'Der gesamte Code gehört in ein Modul
'Variablen Deklaration
' Funktion um Einträge aus einer INI Datei zu Lesen
Private Declare Function ReadINIString Lib "kernel32" _
Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault$, _
ByVal lpReturnedString$, ByVal nSize As Long, _
ByVal lpFileName$) As Long
' Funktion, um Einträge in eine INI Datei zu schreiben
Private Declare Function WriteINIString& Lib _
"kernel32" Alias "WritePrivateProfileStringA" _
(ByVal AppName$, ByVal KeyName$, _
ByVal keydefault$, ByVal FileName$)
'Einstellungen der letzten Ordner werden hier gespeichert
Private Const INI_File = "c:\LastFolder.ini"
'Einstellungen der letzten Ordner werden in diesen
'INI-Section's gespeichert
Private Const LastFolder As String = "LastFolder"
Private Const BaseFolder As String = "C:\DQM\Messung"
Function SaveMyFolder(mysection As String, newFolder As String)
'1. Zuletzt verwendeten Ordner speichern
WriteINIString mysection, mysection, newFolder, INI_File
End Function
Function GetMyFolder(mysection As String, LastFolder As String) As String
Dim tmpRead As String
'Variablengrösse bestimmen
'255 Zeichen lang
tmpRead = String(255, 0)
ReadINIString mysection, LastFolder, vbNullString, tmpRead, 255, INI_File
GetMyFolder = Left$(tmpRead, InStr(1, tmpRead, Chr(0)) - 1)
End Function
Sub Rename_and_MoveFiles()
'(C) Ramses
'Verschiebt alle DQM und PS Dateien in einem Ordner
'in einen Zielordner und nummeriert diese neu
'Die Einstellungen BaseFolder und LastFolder werden in einer INI-Datei gespeichert
Dim tmpName As String, tarName As String, tarPath As String, srcPath As String
Dim myFSO As Object, myFld As Object, myFldFiles As Object, myFile As Object
Dim objFolder As Object, objFolderItem As Object, objShell As Object
Dim psCount As Integer, dqmCount As Integer, dqmCounter As Integer, psCounter As Integer
Dim Qe As Integer
Dim fSearch As FileSearch
Dim myErr As Integer
'ErrorHandler starten
On Error GoTo myErrorHandler
'Erstellen des FileSystemObjectes
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
'Zielordner auswählen
NewTargetPath:
Set objFolder = objShell.BrowseForFolder(0&, "Ziel Ordner auswählen..." & Chr$(13) & _
"ABBRECHEN um neuen Zielordner im Basisverzeichnis: """ & BaseFolder & """ zu erstellen.", 0&, GetMyFolder(LastFolder, LastFolder))
If objFolder Is Nothing Then
'Bei Abbrechen !!!! wenn neuer Zielordner im Basisfolder erstellt werden soll !!!
Qe = MsgBox("Möchten Sie einen neuen Zielordner erstellen ?", vbQuestion + vbYesNo, "Ziel ändern ?")
If Qe = vbYes Then
Set objFolder = objShell.BrowseForFolder(0&, "Ziel Ordner auswählen...", 0&, GetMyFolder(BaseFolder, BaseFolder))
If objFolder Is Nothing Then Exit Sub
Else
Exit Sub
End If
End If
Set objFolderItem = objFolder.Self
tarPath = objFolderItem.Path
If Not myFSO.folderexists(tarPath) Then
MsgBox "Der Ordner :"" " & tarPath & " "" existiert nicht.", vbCritical + vbOKOnly, "Abbruch"
Exit Sub
End If
'Prüfung ob Quell und Zielordner gleich sind
If BaseFolder = tarPath Then
Qe = MsgBox("Der Quell- und der Zielpfad sind gleich." & Chr$(13) & _
"Neuen Ordner auswählen ?", vbCritical + vbYesNo, "Abbruch ?")
If Qe = vbNo Then
Exit Sub
Else
GoTo NewTargetPath
End If
End If
'Wenn neuer Zielordner definiert wurde diesen speichern
If tarPath <> GetMyFolder(LastFolder, LastFolder) Then
SaveMyFolder LastFolder, tarPath
End If
'File Search Initialisieren um die Anzahl Dateien zu bestimmen
Set fSearch = Application.FileSearch
With fSearch
'ermitteln der Anzahl von *.dqm - Files im Zielordner
.NewSearch
.LookIn = tarPath
.SearchSubFolders = False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.FileName = "*.dqm"
.Execute
dqmCount = .FoundFiles.Count + 1
'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 + 1
End With
'Move Schleife starten
Set myFld = myFSO.GetFolder(BaseFolder)
'Zuweisung der Dateien in diesem Ordner
Set myFldFiles = myFld.Files
For Each myFile In myFldFiles
tmpName = myFile.Name
'Andere Files vom Kopiervorgang ausschliessen
If Right(tmpName, 3) = "dqm" Or Right(tmpName, 2) = "ps" Then
If Right(tmpName, 3) = "dqm" Then
tarName = tarPath & "\Mp" & Format(dqmCount, "000") & ".dqm"
'DQM Zähler hochsetzen
dqmCounter = dqmCounter + 1
dqmCount = dqmCount + 1
ElseIf Right(tmpName, 2) = "ps" Then
tarName = tarPath & "\Mp" & Format(psCount, "000") & ".ps"
'PS Zähler hochsetzen
psCounter = psCounter + 1
psCount = psCount + 1
End If
myFSO.MoveFile myFile, tarName
End If
MoveRestart:
Next
MsgBox "Es wurden "" " & dqmCounter & " dqm-Files "" und "" " & Chr$(13) & _
psCounter & " ps-Files "" Dateien verschoben"
'Fehlerbehandlung Ende
myErrorExit:
Exit Sub
'Fehlerbehandlung starten
myErrorHandler:
Select Case Err
Case 58
Qe = MsgBox("Die Datei "" " & myFile & " "" mit dem neuen Namen: "" " & tarName & _
" "" existiert bereits im Folder " & tarPath & Chr$(13) & _
"Soll das Makro abgebrochen werden ?" & Chr$(13) & _
"Bei NEIN wird versucht die restlichen Dateien zu verschieben ?! ", _
vbCritical + vbYesNoCancel, "Doppelte Datei")
If Qe = vbYes Then
MsgBox "Makro wird abgebrochen"
Resume myErrorExit
Exit Sub
End If
Resume MoveRestart
Case Else
MsgBox Err.Number & ": " & Err.Description, vbCritical + vbOKOnly, "Unerwarteter Fehler  >  Abbruch File-Move Action"
Resume myErrorExit
End Select
End Sub

Gruss Rainer
AW: Ich glaub es nicht!!!!!!
08.05.2005 21:36:32
Rene
Hi Rainer,
Was sagt eigentlich myFile aus weil ich bin der Meinung er greift nicht auf die richtigen Dateien zu:
Gruß Rene
AW: Ich glaub es nicht!!!!!!
08.05.2005 21:48:01
Ramses
Hallo
geh mal mit F8 Schritt für Schritt durch.
Dann kannst du auf myFile zeigen. Du wirst sehen, der Code greift auf die erste gefundene *.dqm Datei im Quell-Ordner zu.
Gruss Rainer
AW: Ich glaub es nicht!!!!!!
08.05.2005 22:04:10
Rene
Hi Rainer,
Ich glaube du bist mittlerweile ganz schön am verzweifeln mit mir mir ist nun aufgefallen das er in die ini Datei gar keine BasisOrdner schreibt da steht nur was von dem letzten Ziel Ordner deswegen weiß er ja gar nicht wo er die Dateien suchen soll.
Sagt dir das etwas?
Rene
AW: Zusätzliche Info...
08.05.2005 19:37:22
Reinhard
Hallo Rainer,
es ehrt mich dir auch mal helfen zu können :-))
Benutz doch <pre> vor den relevanten Zeilen und danach </pre>, dann klappts mit den Einrückungen im Code und auch mit dem Private Declare usw. , klar auch mit .
Und man kann auch ma im Text das Wort Sub erwähnen ohne dass umbrochen wird.
Gruß
Reinhard

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige