Neregistrovaný Přihlásit Registrovat

Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno VBA počkaj kým skončí aplikácia

Dobrý deň,

v outlooku som spravil scriptík, ktorý zapína/vypína out of office resp. vytvára/maže súbor na sieťovom disku (ktorého prítomnosť kontroluje shell scriptik na mail serveri a ten podľa toho či existuje vypina/zapina out of office pre konkrétneho usera). Potrebujem ale doriešiť jednu vec. Chcem aby script počkal kým užívateľ nevypne notepad. Nakoľko shell scriptik kontroluje prítomnosť súboru každých 10 sec a keď nájde tak nakopíruje out of office text ktorý je tam. Teda preto potrebujem vytvoriť súbor nemaz az po zavretí notepadu.

aby sa zastavil po tomto
linne = "notepad G:/oooffice/rhenus-kuchar/text.txt"
Shell linne

a pokračoval až keď užívateľ vypne notepad.
Vedel by mi niekto s tým poradiť?

Private Sub Application_Quit()
Dim objFileSystem, objOutputFile
Dim strOutputFile
If MsgBox("Chcete zapnut Out Of office?", vbYesNo, "Aktivacia out of office") = vbYes Then
Dim linne As String
linne = "notepad G:/oooffice/rhenus-kuchar/text.txt"
Shell linne

strOutputFile = "G:/oooffice/rhenus-kuchar/nemaz"
Set objFileSystem = CreateObject("Scripting.fileSystemObject")
Set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, True)
objOutputFile.WriteLine ("ondrej.kuchar@sk.rhenus.com")
objOutputFile.Close
Set objFileSystem = Nothing

Else

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists("G:/oooffice/rhenus-kuchar/nemaz") ) Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile ("G:/oooffice/rhenus-kuchar/nemaz")
End If

End If
End Sub

Private Sub Application_Startup()
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists("G:/oooffice/rhenus-kuchar/nemaz") ) Then
If MsgBox("Mate zapnuty out of office. Chcete ho vypnut?", vbYesNo, "Dektivacia out of office") = vbYes Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile ("G:/oooffice/rhenus-kuchar/nemaz")
End If
End If
End Sub

Předmět Autor Datum
Private Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInher… nový
host 24.06.2009 00:03
 host
dakujem pekne funguje sice az po pol hodine laborovania ale ide to je hlavne :) poslední
eth4rendil 26.06.2009 09:20
 eth4rendil 
Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long


Private Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long


Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long
    Public Const PROCESS_QUERY_INFORMATION = &H400
                                    
 

Sub Command1_Click()

    RunShell "c:\windows\notepad.exe"
End Sub

Private Sub RunShell (cmdline$)

    Dim hProcess As Long
    Dim ProcessId As Long
    Dim exitCode As Long
    ProcessId& = Shell(cmdline$, 1)
    hProcess& = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId&)


    Do
        Call GetExitCodeProcess(hProcess&, exitCode&)


        DoEvents
        Loop While exitCode& > 0

        MsgBox "The Shelled process " & cmdline$ & " has ended."
    End Sub

http://www.experts-exchange.com/Programming/Langua ges/Visual_Basic/Q_10189013.html

Zpět do poradny Odpovědět na původní otázku Nahoru