急!请大家帮助,关于在VBA中结束EXCEL进程的问题,有劳大家了!

时间:2022-08-27 08:37:00
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim xlsheet1 As Excel.Worksheet
Dim xlsheet2 As Excel.Worksheet
Dim NAME As String
Dim h As Integer
Dim 目录 As String
Dim P As Integer
Set xlapp = New Excel.Application
Set xlapp = CreateObject("excel.application")
Set xlbook = xlapp.Workbooks.Open("D:\GTEMOL\MOLMASTER.XLS")
Set xlsheet = xlbook.Worksheets.Item("SHT")
NAME = Form2.Combo1 & Form2.Combo2 & Form2.Combo3 & "-" & Form2.Combo4 & Form2.Combo5
Set xlsheet1 = xlbook.Worksheets.Item(NAME)
Set xlsheet2 = xlbook.Worksheets.Item("客户情报")
h = xlsheet.Range("A1").CurrentRegion.Rows.Count
xlsheet.Range("A2:Q" & h).Delete
h = xlsheet1.Range("A1").CurrentRegion.Rows.Count
M = 1
For n = 1 To h
If xlsheet1.Range("K" & n) > 0 Then
xlsheet.Range("A" & M).Value = xlsheet1.Range("A" & n).Value
xlsheet.Range("B" & M).Value = xlsheet1.Range("B" & n).Value
xlsheet.Range("C" & M).Value = xlsheet1.Range("C" & n).Value
xlsheet.Range("D" & M).Value = xlsheet1.Range("D" & n).Value
xlsheet.Range("E" & M).Value = xlsheet1.Range("E" & n).Value
xlsheet.Range("F" & M).Value = xlsheet1.Range("F" & n).Value
xlsheet.Range("G" & M).Value = xlsheet1.Range("G" & n).Value
xlsheet.Range("H" & M).Value = xlsheet1.Range("H" & n).Value
xlsheet.Range("I" & M).Value = xlsheet1.Range("I" & n).Value
xlsheet.Range("J" & M).Value = xlsheet1.Range("J" & n).Value
xlsheet.Range("K" & M).Value = xlsheet1.Range("O" & n).Value
M = M + 1
End If
Next n
xlsheet.Range("m2").Value = "合约编号:"
xlsheet.Range("m3").Value = "合约名称:"
xlsheet.Range("m4").Value = "电梯形式:"
xlsheet.Range("N2").Value = xlsheet2.Range("p2").Value
xlsheet.Range("n3").Value = xlsheet2.Range("c2").Value
xlsheet.Range("n4").Value = NAME & "-" & Form2.Text2 & "STOP"
xlapp.DisplayAlerts = False
xlbook.SaveAs ("D:\GTEMOL\MOLMASTER.XLS")

目录 = Dir("D:\SEIBAN", vbDirectory)
If 目录 = "" Then
    MkDir ("D:\SEIBAN")
End If
HETONG = xlsheet2.Cells(2, 16)
P = xlsheet.Range("A1").CurrentRegion.Rows.Count
xlsheet.Range("A1:R" & P).Copy
xlapp.Workbooks.Add (xlWorksheet)
With xlapp.ActiveSheet
.Paste
Application.CutCopyMode = False
.Range("A:p").Columns.AutoFit
End With
ChDir "D:\"
xlapp.ActiveWorkbook.SaveAs FileName:="D:\SEIBAN\" & HETONG
xlapp.ActiveWorkbook.Close SAVECHANGES:=True, FileName:=HETONG

xlbook.Close (True)
xlapp.Quit
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing

39 个解决方案

#1


还好只差一句了
Application.CutCopyMode = False
改成
xlapp.CutCopyMode = False

#2


我试了,不好用,进程还是不能结束,急!

#3


你试着调用API函数

#4


怎么调用,给予帮助

#5


把xlapp.Visible设成true,一直监视着它吧

#6


删除这句
Set xlapp = CreateObject("excel.application")

#7


我用的是杀调进程池中的对象句柄
可以用一个数组或是控件保存进程池中所有进程,然后杀掉你想杀的进程
Process_list() 是列出进程池中所有进程
process_quit() 是杀死要想杀的进程

Sub Process_List()
Dim i As Integer
Dim proc As PROCESSENTRY32
Dim snap As Long
Dim exename As String
ListView1.ListItems.Clear                                 
snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0)   '获得进程“快照”的句柄
proc.dwSize = Len(proc)
theloop = ProcessFirst(snap, proc)       '获取第一个进程,并得到其返回值
i = 0
While theloop <> 0      '当返回值非零时继续获取下一个进程
exename = proc.szExeFile
ret = ListView1.ListItems.Add(, "first" & CStr(i), exename)  '将进程名添加到第一项中
ListView1.ListItems("first" & CStr(i)).SubItems(1) = proc.th32ProcessID  
i = i + 1
theloop = ProcessNext(snap, proc)
Wend
CloseHandle snap 
End Sub
'=================================================
Sub Process_Quit()
Dim A As Integer
For A = 1 To ListView1.ListItems.Count
    If Right(Trim(ListView1.ListItems(A).Text), 11) = "WINWORD.EXE" Or Right(Trim(ListView1.ListItems(A).Text), 12) = "POWERPNT.EXE" Or Right(Trim(ListView1.ListItems(A).Text), 9) = "EXCEL.EXE" Then
        hand = OpenProcess(PROCESS_TERMINATE, False, CLng(ListView1.ListItems(A).SubItems(1)))   '获取进程句柄
        TerminateProcess hand, 0      '关闭进程
    End If
Next A
End Sub

然后就可以在想要杀进程的地方调用这俩个过程就可以了
Process_List
Process_Quit

#8


杀掉进程:
    Public Sub EraseExcel()
        Dim pTemp As System.Diagnostics.Process()
        pTemp = System.Diagnostics.Process.GetProcesses()
        Dim pTempProcess As System.Diagnostics.Process

        For Each pTempProcess In pTemp
            Dim sProcessName As String = pTempProcess.ProcessName
            Dim sProcessID As Int32 = pTempProcess.Id
            If StrComp("excel", sProcessName, CompareMethod.Text) = 0 Then
                Dim pProcessTemp As System.Diagnostics.Process
                pProcessTemp = Process.GetProcessById(sProcessID)
                pProcessTemp.Kill()
                pProcessTemp.Close()
            End If
        Next

    End Sub

#9


我说楼上的,你的System.Diagnostics.Process()是不是要引用什么东西呀?

#10


关注,帮你顶!

#11


我也遇到同样的问题,热切关注

#12


我也曾遇到相同的问题,但已经解决了.当时不杀进程好像有很严重的后果,比如打开第二次,上一次的就跟着出来,或者进程不死资源消耗等等.必须杀进程,这样才能反复用.我记得这样就OK了.
            exwbook.Saved = True '文档已经保存,不管保存与否设置成这个WIN就认为保存了.
            exwbook.Close        '有上一句垫底,他可以毫不费力的关掉.
            '用 Quit 方法关闭 Microsoft Excel
             ex.Quit             '这句最关键.因没有此句引起.
            '释放对象
            Set ex = Nothing
            Set exwbook = Nothing
            Set exsheet = Nothing

#13


上面试过了,还是不行
请问,那个杀进程的代码应该引用什么库?

#14


对呀,还是杀不掉的,急呀,这个问题是不是VB不能解决呀

#15


路过,回头再研究!

#16


我也有這個問題,那幾個殺進程的程序是不是要引用什麼東東啊,請以上幾位大哥指點一下啊,多謝!

#17


楼上那位兄弟吧.NET的代码都搬来了

#18


creazyfish(梳分头的鱼) 大哥,有沒有什麼好的方法可以實現啊?

#19


其实,我觉得你的代码没有任何的问题啊,一般都是这么做的,你重新启动下机器,或者到其他机器上跑下呢看看有这种问题吗?

#20


有啊,在其它的機子上也存在這種問題啊,我的程序中引用了EXCEL中的宏後就出現以上情況,不引用宏就可以正常結束進程,能不能強制結束該進程啊,具體代碼怎麼寫,還請告知啊??

#21


ding!

#22


晕,现在说的是VB 6.0,那是VB.NET吧!

#23


问题可能是剪切板不为空引起的。试试在quit Excel前运行这个:

Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long


Public Function ClearClipboard()
    Dim lResult As Long
    Dim lTmp1 As Long
    
    lTmp1 = 0
    ' lResult = 0 indicates failure for all three of these API calls
    lResult = OpenClipboard(lTmp1)
    If lResult <> 0 Then
        lResult = EmptyClipboard
        lResult = CloseClipboard
    End If
End Function

实在不行用ExitProcess API.

#24


再看了一下你的代码,ExitProcess不适用。

#25


要用的是TerminateProcess(参见这里:http://dev.csdn.net/article/32/32330.shtm)。

对不起,有点大喘气,:-)

#26


那裡面的代碼不行啊,有沒有2000+VB6.0寫的啊??

#27


嗯,那个CreateToolhelp32Snapshot大概是XP才有的,自己EnumProcess吧。参考资料应该网上多的很。

#28


那个api是EnumProcesses...

#29


樓上的說清楚點好不好啊??

#30


密切关注中。。。。。

#31


大哥,你去google一下declare enumprocesses,现成的代码有的是,我还能说啥?:-)

#32


google 不到啊?樓上的大哥幫我Google一下好吧?、

#33


呵呵,如果星期一之前还没有明确的解答偶给你贴一个...

#34


试试看~


开始的地方改成这样:

Dim xlapp As New Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim xlsheet1 As Excel.Worksheet
Dim xlsheet2 As Excel.Worksheet

Set xlbook = xlapp.Workbooks.Open(App.Path & "\test.xls")
Set xlsheet = xlbook.Worksheets.Item("SHT")
Set xlsheet1 = xlbook.Worksheets.Item(NAME)
Set xlsheet2 = xlbook.Worksheets.Item("客户情报")



退出的时候这样写:

Set xlsheet = Nothing
Set xlsheet1 = Nothing
Set xlsheet2 = Nothing

xlbook.Close (True)
Set xlbook = Nothing

xlapp.Quit
Set xlapp = Nothing

#35


不行,我也出现上面的问题。。

#36


看看这个,
http://community.csdn.net/Expert/topic/3673/3673260.xml?temp=.8720972
我也是从这边搜索的,所以大家在回帖和发帖时最好先搜索几次。
例子行不行我不知,我还没试,我的问题也还没有解决呢。
回头找到了发个邮件给我。sky9705@sohu.com

#37


大概你用的goole跟我的不同?

http://www.google.com/search?hl=en&q=declare+enumprocesses&btnG=Google+Search

我看第二个的代码就可以用:
http://www.vbaccelerator.com/home/VB/Tips/Getting_Process_Information_Using_PSAPI/article.asp

#38


顶起来!

#39


牛比呀

#1


还好只差一句了
Application.CutCopyMode = False
改成
xlapp.CutCopyMode = False

#2


我试了,不好用,进程还是不能结束,急!

#3


你试着调用API函数

#4


怎么调用,给予帮助

#5


把xlapp.Visible设成true,一直监视着它吧

#6


删除这句
Set xlapp = CreateObject("excel.application")

#7


我用的是杀调进程池中的对象句柄
可以用一个数组或是控件保存进程池中所有进程,然后杀掉你想杀的进程
Process_list() 是列出进程池中所有进程
process_quit() 是杀死要想杀的进程

Sub Process_List()
Dim i As Integer
Dim proc As PROCESSENTRY32
Dim snap As Long
Dim exename As String
ListView1.ListItems.Clear                                 
snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0)   '获得进程“快照”的句柄
proc.dwSize = Len(proc)
theloop = ProcessFirst(snap, proc)       '获取第一个进程,并得到其返回值
i = 0
While theloop <> 0      '当返回值非零时继续获取下一个进程
exename = proc.szExeFile
ret = ListView1.ListItems.Add(, "first" & CStr(i), exename)  '将进程名添加到第一项中
ListView1.ListItems("first" & CStr(i)).SubItems(1) = proc.th32ProcessID  
i = i + 1
theloop = ProcessNext(snap, proc)
Wend
CloseHandle snap 
End Sub
'=================================================
Sub Process_Quit()
Dim A As Integer
For A = 1 To ListView1.ListItems.Count
    If Right(Trim(ListView1.ListItems(A).Text), 11) = "WINWORD.EXE" Or Right(Trim(ListView1.ListItems(A).Text), 12) = "POWERPNT.EXE" Or Right(Trim(ListView1.ListItems(A).Text), 9) = "EXCEL.EXE" Then
        hand = OpenProcess(PROCESS_TERMINATE, False, CLng(ListView1.ListItems(A).SubItems(1)))   '获取进程句柄
        TerminateProcess hand, 0      '关闭进程
    End If
Next A
End Sub

然后就可以在想要杀进程的地方调用这俩个过程就可以了
Process_List
Process_Quit

#8


杀掉进程:
    Public Sub EraseExcel()
        Dim pTemp As System.Diagnostics.Process()
        pTemp = System.Diagnostics.Process.GetProcesses()
        Dim pTempProcess As System.Diagnostics.Process

        For Each pTempProcess In pTemp
            Dim sProcessName As String = pTempProcess.ProcessName
            Dim sProcessID As Int32 = pTempProcess.Id
            If StrComp("excel", sProcessName, CompareMethod.Text) = 0 Then
                Dim pProcessTemp As System.Diagnostics.Process
                pProcessTemp = Process.GetProcessById(sProcessID)
                pProcessTemp.Kill()
                pProcessTemp.Close()
            End If
        Next

    End Sub

#9


我说楼上的,你的System.Diagnostics.Process()是不是要引用什么东西呀?

#10


关注,帮你顶!

#11


我也遇到同样的问题,热切关注

#12


我也曾遇到相同的问题,但已经解决了.当时不杀进程好像有很严重的后果,比如打开第二次,上一次的就跟着出来,或者进程不死资源消耗等等.必须杀进程,这样才能反复用.我记得这样就OK了.
            exwbook.Saved = True '文档已经保存,不管保存与否设置成这个WIN就认为保存了.
            exwbook.Close        '有上一句垫底,他可以毫不费力的关掉.
            '用 Quit 方法关闭 Microsoft Excel
             ex.Quit             '这句最关键.因没有此句引起.
            '释放对象
            Set ex = Nothing
            Set exwbook = Nothing
            Set exsheet = Nothing

#13


上面试过了,还是不行
请问,那个杀进程的代码应该引用什么库?

#14


对呀,还是杀不掉的,急呀,这个问题是不是VB不能解决呀

#15


路过,回头再研究!

#16


我也有這個問題,那幾個殺進程的程序是不是要引用什麼東東啊,請以上幾位大哥指點一下啊,多謝!

#17


楼上那位兄弟吧.NET的代码都搬来了

#18


creazyfish(梳分头的鱼) 大哥,有沒有什麼好的方法可以實現啊?

#19


其实,我觉得你的代码没有任何的问题啊,一般都是这么做的,你重新启动下机器,或者到其他机器上跑下呢看看有这种问题吗?

#20


有啊,在其它的機子上也存在這種問題啊,我的程序中引用了EXCEL中的宏後就出現以上情況,不引用宏就可以正常結束進程,能不能強制結束該進程啊,具體代碼怎麼寫,還請告知啊??

#21


ding!

#22


晕,现在说的是VB 6.0,那是VB.NET吧!

#23


问题可能是剪切板不为空引起的。试试在quit Excel前运行这个:

Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long


Public Function ClearClipboard()
    Dim lResult As Long
    Dim lTmp1 As Long
    
    lTmp1 = 0
    ' lResult = 0 indicates failure for all three of these API calls
    lResult = OpenClipboard(lTmp1)
    If lResult <> 0 Then
        lResult = EmptyClipboard
        lResult = CloseClipboard
    End If
End Function

实在不行用ExitProcess API.

#24


再看了一下你的代码,ExitProcess不适用。

#25


要用的是TerminateProcess(参见这里:http://dev.csdn.net/article/32/32330.shtm)。

对不起,有点大喘气,:-)

#26


那裡面的代碼不行啊,有沒有2000+VB6.0寫的啊??

#27


嗯,那个CreateToolhelp32Snapshot大概是XP才有的,自己EnumProcess吧。参考资料应该网上多的很。

#28


那个api是EnumProcesses...

#29


樓上的說清楚點好不好啊??

#30


密切关注中。。。。。

#31


大哥,你去google一下declare enumprocesses,现成的代码有的是,我还能说啥?:-)

#32


google 不到啊?樓上的大哥幫我Google一下好吧?、

#33


呵呵,如果星期一之前还没有明确的解答偶给你贴一个...

#34


试试看~


开始的地方改成这样:

Dim xlapp As New Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim xlsheet1 As Excel.Worksheet
Dim xlsheet2 As Excel.Worksheet

Set xlbook = xlapp.Workbooks.Open(App.Path & "\test.xls")
Set xlsheet = xlbook.Worksheets.Item("SHT")
Set xlsheet1 = xlbook.Worksheets.Item(NAME)
Set xlsheet2 = xlbook.Worksheets.Item("客户情报")



退出的时候这样写:

Set xlsheet = Nothing
Set xlsheet1 = Nothing
Set xlsheet2 = Nothing

xlbook.Close (True)
Set xlbook = Nothing

xlapp.Quit
Set xlapp = Nothing

#35


不行,我也出现上面的问题。。

#36


看看这个,
http://community.csdn.net/Expert/topic/3673/3673260.xml?temp=.8720972
我也是从这边搜索的,所以大家在回帖和发帖时最好先搜索几次。
例子行不行我不知,我还没试,我的问题也还没有解决呢。
回头找到了发个邮件给我。sky9705@sohu.com

#37


大概你用的goole跟我的不同?

http://www.google.com/search?hl=en&q=declare+enumprocesses&btnG=Google+Search

我看第二个的代码就可以用:
http://www.vbaccelerator.com/home/VB/Tips/Getting_Process_Information_Using_PSAPI/article.asp

#38


顶起来!

#39


牛比呀