Thema: Arbeitsmappe blitzschnell kopieren

StandardModule: basMain

Sub Kopieren()
   Dim iCounter As Integer
   Dim sFile As String, sPath As String
   sPath = Application.DefaultFilePath & "\"
   Close
   Open "speichern.bat" For Output As #1
   For iCounter = 1 To 100
      sFile = ThisWorkbook.FullName & " "
      sFile = sFile & sPath & "test" & iCounter & ".xls"
      Print #1, "copy " & sFile
    Next iCounter
    Close
    Call Win32WaitTilFinished("command.com /c speichern.bat")
    Kill "speichern.bat"
    MsgBox "Die Dateien wurde angelegt!"
End Sub

StandardModule: basFunctions

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const WAIT_TIMEOUT = &H102&

Declare Function OpenProcess Lib "kernel32" ( _
   ByVal dwDesiredAccess As Long, _
   ByVal bInheritHandle As Long, _
   ByVal dwProcessId As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" ( _
   ByVal hHandle As Long, _
   ByVal dwMilliseconds As Long) As Long

Sub Win32WaitTilFinished(ProgEXE As String)
   Dim ProcessID As Long
   Dim hProcess As Long
   Dim RetVal As Long
   ProcessID = Shell(ProgEXE, vbHide)
   hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
   Do
      DoEvents
      RetVal = WaitForSingleObject(hProcess, 50)
   Loop Until RetVal <> WAIT_TIMEOUT
End Sub

Beiträge aus dem Excel-Forum zu den Themen Datei und Kopieren