22. marts 2004 - 10:56
Der er
9 kommentarer og
1 løsning
Luk Word (Hårdt, og uden nogensomhelst spørgsmål)
Jeg vil lukke word ned hårdt og brutalt, men kan ikke finde ud af hvordan.
Grunden til at jeg vil gøre det på denne måde er at jeg åbner et word dok, hvor der startes en makro (en form) når dokumentet lukkes, og jeg ønsker ikke at der skal trykkes på nogle knapper.
Jeg skal bare se i dokumentet ikke lave ændringer, dette er forøvrigt ikke noget problem.
Og nej Word.ActivDocument.Close savechanges:= wdDoNotSaveChanges virker ikke, den starter makroen alligevel, i øvrigt startes formen uanset hvad man stiller sikkerhedsniveauet til. Håber nogen kan hjælpe.
22. marts 2004 - 12:18
#9
Prøv at se på det her kode ?
Noget jeg lige rendte over:
'Example is using reference of Microsoft Word 2000 dll library to automate and demonstrate the
'activites in the examples so if you find any trouble in running example then install microsoft word 2000.
Dim WordApp As New Word.Application
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
'create new word document
Dim doc As New Word.Document
'add new word document to word aplication documents collection and
'set the reference of newly created document to "doc" variable
doc = WordApp.Documents.Add()
'string to write
Dim str As String
str = "Text Formatting:"
'with the word app selection write the value in the document
With WordApp.Selection
'set the word selection font size +2 to the selection font size
.Font.Size = WordApp.Selection.Font.Size + 2
'making selection font to bold
.Font.Bold = True
'inserting text in the document
.TypeText(str)
'setting font size back to current-2
.Font.Size = WordApp.Selection.Font.Size - 2
'making the selected font back to false
.Font.Bold = False
'start paragraph
.TypeParagraph()
'change the pragraph text color to red
.Font.Color = Word.WdColor.wdColorDarkRed
'set the selection font not to italic
.Font.Italic = False
'inserting text to the document. that will apear in red
.TypeText("This sentence will appear in red. ")
'start paragraph
.TypeParagraph()
'change the paragraph text color to black
.Font.Color = Word.WdColor.wdColorBlack
'set the selection font to italic
.Font.Italic = True
'setting font size back to current+2
.Font.Size = WordApp.Selection.Font.Size + 2
'inserting text to the document. that will apear in black
.TypeText("Text color was reset to black, " & _
"but the font size was increased by two points")
End With
'filename
Dim fName As String
SaveFileDialog1.Filter = "Documents|*.doc"
SaveFileDialog1.ShowDialog()
fName = SaveFileDialog1.FileName
'if fname is nothing then show document's save as dialog
If fName <> "" Then
Try
doc.SaveAs(fName)
Catch exc As Exception
MsgBox("Failed to save document" & _
vbCrLf & exc.Message)
End Try
End If
'counting of paragraphs word and characters
MsgBox("The document contains " & doc.Paragraphs.Count & " paragraphs " & vbCrLf & _
doc.Words.Count & " words and " & doc.Characters.Count & " words")
'closing document
doc.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
End Sub
22. marts 2004 - 12:23
#10
Tak til Alle for forsøgene, jeg har fundet følgende her på eksperten, og det er det jeg skal bruge så jeg lukker nu:
Option Explicit
Const MAX_PATH& = 260
Declare Function TerminateProcess _
Lib "kernel32" (ByVal ApphProcess As Long, _
ByVal uExitCode As Long) As Long
Declare Function OpenProcess Lib _
"kernel32" (ByVal dwDesiredAccess As Long, _
ByVal blnheritHandle As Long, _
ByVal dwAppProcessId As Long) As Long
Declare Function ProcessFirst _
Lib "kernel32" Alias "Process32First" _
(ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext _
Lib "kernel32" Alias "Process32Next" _
(ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
Declare Function CreateToolhelpSnapshot _
Lib "kernel32" Alias "CreateToolhelp32Snapshot" _
(ByVal lFlags As Long, _
lProcessID As Long) As Long
Declare Function CloseHandle _
Lib "kernel32" (ByVal hObject As Long) As Long
Private Type LUID
lowpart As Long
highpart As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
LuidUDT As LUID
Attributes As Long
End Type
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Declare Function GetVersion _
Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess _
Lib "kernel32" () As Long
Private Declare Function OpenProcessToken _
Lib "advapi32" (ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue _
Lib "advapi32" Alias "LookupPrivilegeValueA" _
(ByVal lpSystemName As String, _
ByVal lpName As String, _
lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges _
Lib "advapi32" (ByVal TokenHandle As Long, _
ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, _
PreviousState As Any, _
ReturnLength As Any) As Long
Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szexeFile As String * MAX_PATH
End Type
'---------------------------------------
Public Function KillApp(myName As String) As Boolean
Const TH32CS_SNAPPROCESS As Long = 2&
Const PROCESS_ALL_ACCESS = 0
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Dim exitCode As Long
Dim myProcess As Long
Dim AppKill As Boolean
Dim appCount As Integer
Dim i As Integer
On Local Error GoTo Finish
appCount = 0
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
If Right$(szExename, Len(myName)) = LCase$(myName) Then
KillApp = True
appCount = appCount + 1
myProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
If KillProcess(uProcess.th32ProcessID, 0) Then
'For debug.... Remove this
' MsgBox "Instance no. " & appCount & " of " & szExename & " was terminated!"
End If
End If
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
Call CloseHandle(hSnapshot)
Exit Function
Finish:
MsgBox "Error!"
End Function
'Terminate any application and return an exit code to Windows.
Function KillProcess(ByVal hProcessID As Long, Optional ByVal exitCode As Long) As Boolean
Dim hToken As Long
Dim hProcess As Long
Dim tp As TOKEN_PRIVILEGES
If GetVersion() >= 0 Then
If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) = 0 Then
GoTo CleanUp
End If
If LookupPrivilegeValue("", "SeDebugPrivilege", tp.LuidUDT) = 0 Then
GoTo CleanUp
End If
tp.PrivilegeCount = 1
tp.Attributes = SE_PRIVILEGE_ENABLED
If AdjustTokenPrivileges(hToken, False, tp, 0, ByVal 0&, ByVal 0&) = 0 Then
GoTo CleanUp
End If
End If
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
If hProcess Then
KillProcess = (TerminateProcess(hProcess, exitCode) <> 0)
' close the process handle
CloseHandle hProcess
End If
If GetVersion() >= 0 Then
' under NT restore original privileges
tp.Attributes = 0
AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&
CleanUp:
If hToken Then CloseHandle hToken
End If
End Function
' End Module code
'Example on how to use the code' this is the click event of a button named cmdKill
Private Sub cmdKill()
' Usage:
Dim pID As Long
Dim i As Integer
Dim strExe As String
'C:\Programmer\Microsoft Office\Office10\
strExe = "winword.exe"
For i = 0 To 4
pID = Shell(strExe, vbNormalFocus)
Next i
'KillProcess pID, 0
' KillApp ("winword.exe")
'Five instances of notpade.exe is now created
'Debug.Assert False
'KillApp (strExe)
MsgBox "It is " & _
KillApp(strExe) & _
" that all instances of " & vbCrLf & _
strExe & _
" have been terminated!"
End Sub
