XCOPY - SHELL und ein paar Dinge mehr...

'--------------------------------------------------------------------------
' Module    : Module1
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : XCOY, SHELL - Beispiele und Informationen ausgeben...
'--------------------------------------------------------------------------
OptionExplicit
PrivateDeclareFunctionMakeSureDirectoryPathExistsLib"imagehlp.dll"(_
ByValDirPathAsString)AsLong
ConststrTMPAsString="C:\Temp\"
ConststrEXAsString="*.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.
SubMain()
Shell("xcopy "&ThisWorkbook.Path&Application.PathSeparator&"source"&_
Application.PathSeparator&strEX&" "&ThisWorkbook.Path&_
Application.PathSeparator&"destination")
EndSub
' 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.
SubMain_1()
Shell("xcopy /Y "&ThisWorkbook.Path&Application.PathSeparator&"source"&_
Application.PathSeparator&strEX&" "&ThisWorkbook.Path&_
Application.PathSeparator&"destination")
EndSub
' Bindet den Pfad "C:\Temp\source" als Laufwerk w: ein
SubMain_2()
Shell("subst w: "&ThisWorkbook.Path&Application.PathSeparator&"source")
Shell"Explorer.exe /E, w:",vbMaximizedFocus
EndSub
' Entfernt das virtuelle Laufwerk w:
SubMain_3()
Shell("subst /d w:")
EndSub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterX
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Parameter von XCOPY in Notepad ausgeben...
'--------------------------------------------------------------------------
SubParameterX()
OnErrorGoToFin
MakeSureDirectoryPathExistsstrTMP
ShellAndWait"cmd /c xcopy /? > "&strTMP&"xco.txt"
Shell"Notepad "&strTMP&"xco.txt",vbMaximizedFocus
Fin:
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterS
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Parameter von SET an bestehende Datei anhängen...
'--------------------------------------------------------------------------
SubParameterS()
OnErrorGoToFin
MakeSureDirectoryPathExistsstrTMP
ShellAndWait"cmd /c set /? >> "&strTMP&"xco.txt"
Shell"Notepad "&strTMP&"xco.txt",vbMaximizedFocus
Fin:
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterI
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Komplette IP Konfiguration aller LAN Adapter ausgeben...
'--------------------------------------------------------------------------
SubParameterI()
OnErrorGoToFin
MakeSureDirectoryPathExistsstrTMP
ShellAndWait"cmd /c ipconfig /all > "&strTMP&"ip.txt"
Shell"Notepad "&strTMP&"ip.txt",vbMaximizedFocus
Fin:
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterT
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Komplette IP Konfiguration aller LAN Adapter ausgeben...
'--------------------------------------------------------------------------
SubParameterT()
OnErrorGoToFin
MakeSureDirectoryPathExistsstrTMP
ShellAndWait"cmd /c tasklist > "&strTMP&"ta.txt"
Shell"Notepad "&strTMP&"ta.txt",vbMaximizedFocus
Fin:
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterT1
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Komplette IP Konfiguration aller LAN Adapter ausgeben...
'--------------------------------------------------------------------------
SubParameterT1()
OnErrorGoToFin
MakeSureDirectoryPathExistsstrTMP
ShellAndWait"cmd /c tasklist /V > "&strTMP&"ta1.txt"
Shell"Notepad "&strTMP&"ta1.txt",vbMaximizedFocus
Fin:
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ShellAndWait
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : ShellAndWait mit ausgeblendetem Dosfenster...
'--------------------------------------------------------------------------
PrivateSubShellAndWait(ByValstrPathNameAsString)
DimWshShellAsObject
OnErrorGoToFin
SetWshShell=CreateObject("WScript.Shell")
WshShell.RunstrPathName,0,True
Fin:
SetWshShell=Nothing
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub