XCOPY - SHELL und ein paar Dinge mehr...

Frage: Alle Exceldateien eines Ordners als Sicherungskopie in einen anderen Ordner kopieren. Wie geht das?

Programme direkt im VBA Editor starten. Informationen bzw. Parameter zu bestimmten Dos Befehlen in einer Textdatei mit Notepad anzeigen.

Damit das "gute alte Dos" nicht in Vergessenheit gerät. :-)

All Excel files in a folder as a backup copy in another folder. How does it work?

Launch programs directly in the VBA editor. Information or parameters on certain dos commands display in a text file with Notepad.

Thus, the "good old Dos" will not be forgotten. :-)

Hier noch eine Beispieldatei / Here's a sample file:
XCOPY - SHELL und ein paar Dinge mehr...[ZIP 50 KB]

'--------------------------------------------------------------------------
' Module    : Module1
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : XCOY, SHELL - Beispiele und Informationen ausgeben...
'--------------------------------------------------------------------------
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long
Const strTMP As String = "C:\Temp\"
Const strEX As String = "*.xls"
' Alle Exceldateien die im Unterordner "source" sind (dieser befindet sich
' unterhalb des Pfades in dem die Datei mit diesem Code ist) werden in das
' Unterverzeichnis "destination" kopiert. Wird der Code zum zweiten mal
' ausgeführt, WIRD nachgefragt, ob die vorhandenen Dateien
' überschrieben werden sollen.
Sub Main()
    Shell ("xcopy " & ThisWorkbook.Path & Application.PathSeparator & "source" & _
        Application.PathSeparator & strEX & " " & ThisWorkbook.Path & _
        Application.PathSeparator & "destination")
End Sub
' Alle Exceldateien die im Unterordner "source" sind (dieser befindet sich
' unterhalb des Pfades in dem die Datei mit diesem Code ist) werden in das
' Unterverzeichnis "destination" kopiert. Wird der Code zum zweiten mal
' ausgeführt, wird NICHT nachgefragt, ob die vorhandenen Dateien
' überschrieben werden sollen.
Sub Main_1()
    Shell ("xcopy /Y " & ThisWorkbook.Path & Application.PathSeparator & "source" & _
        Application.PathSeparator & strEX & " " & ThisWorkbook.Path & _
        Application.PathSeparator & "destination")
End Sub
' Bindet den Pfad "C:\Temp\source" als Laufwerk w: ein
Sub Main_2()
    Shell ("subst w: " & ThisWorkbook.Path & Application.PathSeparator & "source")
    Shell "Explorer.exe /E, w:", vbMaximizedFocus
End Sub
' Entfernt das virtuelle Laufwerk w:
Sub Main_3()
    Shell ("subst /d w:")
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterX
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Parameter von XCOPY in Notepad ausgeben...
'--------------------------------------------------------------------------
Sub ParameterX()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c xcopy /? > " & strTMP & "xco.txt"
    Shell "Notepad " & strTMP & "xco.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterS
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Parameter von SET an bestehende Datei anhängen...
'--------------------------------------------------------------------------
Sub ParameterS()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c set /? >> " & strTMP & "xco.txt"
    Shell "Notepad " & strTMP & "xco.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterI
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Komplette IP Konfiguration aller LAN Adapter ausgeben...
'--------------------------------------------------------------------------
Sub ParameterI()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c ipconfig /all > " & strTMP & "ip.txt"
    Shell "Notepad " & strTMP & "ip.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterT
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Komplette IP Konfiguration aller LAN Adapter ausgeben...
'--------------------------------------------------------------------------
Sub ParameterT()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c tasklist > " & strTMP & "ta.txt"
    Shell "Notepad " & strTMP & "ta.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterT1
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Komplette IP Konfiguration aller LAN Adapter ausgeben...
'--------------------------------------------------------------------------
Sub ParameterT1()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c tasklist /V > " & strTMP & "ta1.txt"
    Shell "Notepad " & strTMP & "ta1.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ShellAndWait
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : ShellAndWait mit ausgeblendetem Dosfenster...
'--------------------------------------------------------------------------
Private Sub ShellAndWait(ByVal strPathName As String)
   Dim WshShell As Object
   On Error GoTo Fin
   Set WshShell = CreateObject("WScript.Shell")
   WshShell.Run strPathName, 0, True
Fin:
   Set WshShell = Nothing
   If Err.Number <> 0 Then MsgBox "Error: " & _
       Err.Number & " " & Err.Description
End Sub

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...