Açık olan excel hariç farklı Application excellerini kapatabilirmiyiz.

[ASMET67]

merhaba

Başka bir programdan Excel ile programın script komutlarını kullanarak excel dosyası olarak export ediyorum. Oluşan excel dosyası farklı bir Aplication üzerinde oluştuğu için kodun çalıştığı excelden bu exellere ulaşıp kapatabileceğim bir kod varmıdır.

Yani kodun çalıştığı exceller hariç farklı bir Application üzerinde de olsa bu excelleri kapatabilirmiyiz. Oluşan excellerin isimleri sabit be bu isimlerin olduğu bir listemde var. Liste içinde dönerek açıkmı kontrol edip kapattırabilirmiyiz.

 

[muygun]

Merhaba;

Arşivimden bulduğum kodlar:
Kendisi hariç tüm excelleri kapatır.
Not: 2003 versiyonunda test ettim çalışıyor. (diğer versiyonları bilemem.)

Boş bir modüle;

Sub bu_dosya_hariç_excelleri_kapat()
On Error Resume Next
Dim açık As Workbook
For Each açık In Workbooks
If açık.Name <> ThisWorkbook.Name Then
açık.Close SaveChanges:=True 'değişiklikleri kaydetmeden kapatmak için TRUE yerine FALSE yazın.
say = say + 1
End If
Next açık
If say > 0 Then MsgBox (say & " adet Açık dosya Kapatıldı.")
If say = 0 Then MsgBox (" Kapatılacak dosya YOK.")
End Sub

Ekleyerek deneyin.
İyi çalışmalar.

 

[ASMET67]

Öncelikle cevabının için teşekkür ederim.
Bu kod excel Application içinde acık olan dosyaları kapatıyor. Export edilen excel kendini açarken farklı bir Application oluşturarak açabiliyor. ozaman maalesef kapatamıyor. Bunu yapmanın başka bir yolu varmıdır.

 

[Haluk]

Bahsettiğiniz diğer dosya eğer farklı bir Excel uygulamasında (oturumunda) açılıyorsa, bu iş için mevcut Excel'in "ProcessID" değerini bulduktan sonra diğer Excel uygulamalarının "ProcessID" değerleriyle karşılaştırıp, eğer farklı bir tane bulursa o değere ait Process'i (uygulamayı) sonlandırmak gerekir.

Aşağıdaki kod API ile bu işi yapar;

Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
'
Sub Test()
   Dim objWMIService As Object, objProcess As Object, colProcess As Variant
   Dim strComputer As String
   
   strComputer = "."
   
   Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'excel.exe' And ProcessID <> " & GetCurrentProcessId)
   
   If colProcess.Count > 0 Then
      For Each objProcess In colProcess
         objProcess.Terminate
      Next
   End If
End Sub

.

 

[veyselemre]

Haluk bey cevaplamış ama, 32 bit excel için aşağıdaki gibi de kullanabilirsiniz.
64 bit için ptrSafe eklenmesi gerekir.

Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Sub Test()
    For Each process In GetObject("winmgmts:\\.\root\CIMV2").ExecQuery _
        ("SELECT * FROM Win32_Process where name='excel.exe' and processID<>" & GetCurrentProcessId, , 48)
        'Debug.Print process.processid, process.Name
        process.Terminate
    Next
End Sub

 

[ASMET67]

Bahsettiğiniz diğer dosya eğer farklı bir Excel uygulamasında (oturumunda) açılıyorsa, bu iş için mevcut Excel'in "ProcessID" değerini bulduktan sonra diğer Excel uygulamalarının "ProcessID" değerleriyle karşılaştırıp, eğer farklı bir tane bulursa o değere ait Process'i (uygulamayı) sonlandırmak gerekir.

Aşağıdaki kod API ile bu işi yapar;

Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
'
Sub Test()
   Dim objWMIService As Object, objProcess As Object, colProcess As Variant
   Dim strComputer As String
  
   strComputer = "."
  
   Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'excel.exe' And ProcessID <> " & GetCurrentProcessId)
  
   If colProcess.Count > 0 Then
      For Each objProcess In colProcess
         objProcess.Terminate
      Next
   End If
End Sub

.

Kod işime yaradı Çok Teşekkürler