title image


Smiley Re: Datei kopieren/verschieben
Der folgende Code läuft bei mir und verschiebt Dateien von einem Verzeichnis in ein anderes und von dort weiter in ein nächstes.---------------------------------------------------------Die erzeugte .EXE heißt verschieben.exe---------------------------------------------------------Aufruf: verschieben.exe D:\TEST\,D:\TEST\ARBEIT,D:\TEST\TEMP---------------------------------------------------------Sub Main() On Error GoTo Error_main ' Befehlszeile auswerten glretval = UseCommandArgs(Command()) If Not glretval Then Exit Sub End If ' Dateien aus Quellverzeichnis in Arbeitsverzeichnis verschieben glretval = moveFilesFromSourceToDest(glSourceDir, glWorkDir) glretval = moveFilesFromDestToTemp(glWorkDir,glTempDir)Exit_main: Exit SubError_main: glretval = ErrHandle("main") GoTo Exit_main End Sub---------------------------------------------------------Public Function moveFilesFromSourceToDest(pSource As String, pDestination As String) As Integer On Error GoTo Error_moveFilesFromSourceToDest ' Diese Prozedur kopiert die Quelldateien in das Arbeitsverzeichnis. Dim strSource As String Dim strPathSrc As String Dim strPathDest As String Dim DatUndZeit As String moveFilesFromSourceToDest = 0 DatUndZeit = Left(Now, 2) & Mid(Now, 4, 2) & Mid(Now, 7, 2) & Mid(Now, 10, 2) & Mid(Now, 13, 2) & Right(Now, 2) strSource = Dir(pSource & "/*.txt", vbNormal) While strSource "" strPathSrc = pSource & strSource strPathDest = pDestination & strSource & DatUndZeit & ".TXT" FileCopy strPathSrc, strPathDest Kill strPathSrc strSource = Dir Wend moveFilesFromSourceToDest = -1Exit_moveFilesFromSourceToDest: Exit FunctionError_moveFilesFromSourceToDest: glretval = ErrHandle("moveFilesFromSourceToDest") GoTo Exit_moveFilesFromSourceToDestEnd Function---------------------------------------------------------Public Function moveFilesFromDestToTemp(pDestination As String, pTemp As String) As Integer On Error GoTo Error_moveFilesFromDestToTemp ' Diese Prozedur kopiert die Quelldateien in ein temporäres Verzeichnis Dim strDestination As String Dim strPathDest As String Dim strPathTemp As String moveFilesFromDestToTemp = 0 strDestination = Dir(pDestination, vbNormal) While strDestination "" strPathDest = pDestination & strDestination strPathTemp = pTemp & strDestination FileCopy strPathDest, strPathTemp Kill strPathDest strDestination = Dir Wend moveFilesFromDestToTemp = -1Exit_moveFilesFromDestToTemp: Exit FunctionError_moveFilesFromDestToTemp: glretval = ErrHandle("moveFilesFromDestToTemp") GoTo Exit_moveFilesFromDestToTempEnd Function---------------------------------------------------------Public Function UseCommandArgs(BefehlsZeile As String) As IntegerOn Error GoTo Error_UseCommandArgs Dim ArgPos UseCommandArgs = 0 If Len(Trim(BefehlsZeile)) = 0 Then Exit Function End If ArgPos = InStr(1, BefehlsZeile, ",") glSourceDir = CheckPath(Trim(Left(BefehlsZeile, ArgPos - 1))) BefehlsZeile = Mid(BefehlsZeile, ArgPos + 1, Len(Trim(BefehlsZeile))) ArgPos = InStr(1, BefehlsZeile, ",") glWorkDir = CheckPath(Trim(Left(BefehlsZeile, ArgPos - 1))) BefehlsZeile = Mid(BefehlsZeile, ArgPos + 1, Len(Trim(BefehlsZeile))) ArgPos = InStr(1, BefehlsZeile, ",") glTempDir = CheckPath(Trim(Left(BefehlsZeile, ArgPos - 1))) UseCommandArgs = -1Exit_UseCommandArgs: Exit FunctionError_UseCommandArgs: glretval = ErrHandle("UseCommandArgs") GoTo Exit_UseCommandArgs End Function---------------------------------------------------------Public Function CheckPath(pEingabe As String) As StringOn Error GoTo Error_CheckPath CheckPath = pEingabe If Right(pEingabe, 1) "\" Then CheckPath = pEingabe & "\" End IfExit_CheckPath: Exit FunctionError_CheckPath: glretval = ErrHandle("CheckPath") GoTo Exit_CheckPath End Function--------------------------------------------------------Gruß KlauDo

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: