http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** v9.B *** www.dieseyer.de ******************************
'
' Datei: browse-for-file-ie.vbs
' Autor: Joseph Morales
' Auf: www.dieseyer.de
'
'***********************************************************
Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl
' Unter Win7 / Windows 7 ist es ggf. erforderlich den
' 'Datei öffnen ...' Dialog in den Vordergrung zu holen
Call AppActivateVBS ( "Date" ) ' "Date" sind die ersten Zeichen im Fensternamen
MsgBox ChooseFile, , "016 :: " & WScript.ScriptName
WScript.Quit
'*** v6.B *** www.dieseyer.de ******************************
Function ChooseFile()
'***********************************************************
' aus http://groups.google.de/group/microsoft.public.scripting.vbscript/browse_thread/thread/f00a1c5d856c731f/c1d22782d2816bff?lnk=st&q=Joseph+Morales+Here%27s+the+code+with+the+additions+to+make+things&rnum=1#c1d22782d2816bff
Dim IE : Set IE = CreateObject("InternetExplorer.Application")
ChooseFile = ""
IE.visible = False
IE.Navigate("about:blank")
Do Until IE.ReadyState = 4
' WScript.Sleep 33
Loop
IE.TheaterMode = False
IE.Document.Write "<HTML><BODY><INPUT ID=""Fil""Type=""file""></BODY></HTML>"
IE.height = "0"
IE.width = "0"
IE.visible = True
IE.visible = False
With IE.Document.all.Fil
.focus
.click
ChooseFile = .value
End With
IE.Quit
Set IE = Nothing
End Function 'ChooseFile()
'*** v9.4 *** www.dieseyer.de ******************************
Function UserTempVerz
'***********************************************************
' aus 'Scriptomatic v2.0' by 'The MS Scripting Guys'
Dim Tst
On Error Resume Next
err.Clear
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Tst = err.Number & " - " & err.Description
On Error Goto 0
If Len( Tst ) > 4 Then
MsgBox "Das lokale WMI ist defekt - der PC ist für WinTuC momentan nicht geeignet.", vbCritical + 4096, "062 :: " & Titel
SelfClose = "-NO" ' Unterdrückt die Aktualisierung
self.Close
Exit Function
End If
Dim colItems : Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Environment", "WQL", &h10 + &h20 )
Dim objItem
For Each objItem In colItems
If InStr( UCase( objItem.UserName ), UCase( CreateObject("WScript.Network").Username ) ) > 0 Then
' If objItem.SystemVariable = vbFalse Then UserTempVerz = objItem.VariableValue : Exit For
If InStr( UCase( objItem.VariableValue ), "TEMP" ) > 0 Then UserTempVerz = objItem.VariableValue : Exit For
If InStr( UCase( objItem.VariableValue ), "TMP" ) > 0 Then UserTempVerz = objItem.VariableValue : Exit For
End If
Next
' MsgBox UserTempVerz, , "077 :: "
If InStr( UCase( UserTempVerz ), "%USERPROFILE%" ) = 1 Then
UserTempVerz = Mid( UserTempVerz, Len( "%USERPROFILE%" ) + 1 )
UserTempVerz = CreateObject("WScript.Shell").Environment("PROCESS")("USERPROFILE") & UserTempVerz
End If
' MsgBox "UserTempVerz: " & UserTempVerz, , "083 :: " : WScript.Quit
End Function ' UserTempVerz
'*** v9.B *** www.dieseyer.de ******************************
Sub AppActivateVBS( ProgrName )
'***********************************************************
' Prozedur Schreibt ein VBS, das eine Anwendung in den
' Vordergrund holt
Dim ListeDatei, Txt, Datei
Datei = UserTempVerz() & "\" & CreateObject("Scripting.FileSystemObject").GetTempName()
Datei = Mid( Datei, 1, InStrRev( Datei, "." ) ) & "vbs"
' MsgBox Datei, , "096 :: "
Txt = ""
Txt = Txt & vbCRLF & "Do"
Txt = Txt & vbCRLF & "i = i + 1"
Txt = Txt & vbCRLF & "WScript.Sleep 33"
Txt = Txt & vbCRLF & "If CreateObject(""WScript.Shell"").AppActivate( ""Date"") Then Exit Do"
' Txt = Txt & vbCRLF & "WScript.Quit"
Txt = Txt & vbCRLF & "Loop"
' Txt = Txt & vbCRLF & "MsgBox i & ""xxxx"", ," & " ""104 :: "" "
CreateObject("Scripting.FileSystemObject").CreateTextFile( Datei ).Write Txt
CreateObject("WScript.Shell").Run "wscript.exe """ & Datei & """", , False
' CreateObject("WScript.Shell").Run "notepad """ & Datei & """", , False
End Sub ' AppActivateVBS( ProgrName )
http://dieseyer.de • all rights reserved • © 2011 v11.4