'*** 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 "" 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 )