Klasörde dosya yoksa makro ile işlemi atlama !!!

[baykan_m]

Merhaba Arkadaşlar,

Ben D:\Boyahane klasörü içindeki excel dosyalarını açarak bazı işlemler yapıyorum. Ancak bazen D:\Boyahane içerisinde o dosya olmayabiliyor. Bu durumda Makro işlemi yaparken dosya olmadığı için hata uyarısı veriyor. İşte ben bu hata ile karşılaşıldığında hata vermeden diğer makroları uygulamasını istiyorum. Bir diğer deyişle eğer klasörde dosya yoksa işlemi atlamasını istiyorum. Yardım edenlere şimdiden teşekkür ederim.

 

[Asri]

aşağıdak fonksiyonu kullanabilirsiniz.

http://dosya.co/ew5gekdjk9a4/MALİYET_PROGRAM.xlsm.html

Kullanımı,

if dosyavarmi("D:\Boyahane\deneme.xlsx") then
  dosya var ise işleme alınacak makrolar.
end if

Function dosyavarmi(dosya)
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(dosya)
If a = True Then
 dosyavarmi = True
Else
  dosyavarmi = False
End If
End Function

 

[baykan_m]

Öncelikle yardımınız için çok teşekkür ederim. Ancak ben buı makroyu kendi dosyama uygulayamadım. Bi kaç deneme yaptım ancak hep hata verdi. Sürekli end if kısmı için hata verdi anlayamadım. Ben dosyayı ekledim. Burda maliyet hazırla makrosunda her dosya açılmadan önce bu kontrolü yapsın istiyorum. Siz bakabilirmisiniz dosyaya?

Dosya Linki: http://s2.dosya.tc/server5/dprhat/MALIYET_PROGRAM.rar.html

 

[Asri]

Mesaja dosya eklendi.

VBA Tools References den Microsoft Scripting Runtime seçili olması gerekiyordu. Bu belirtmemişim.

Makroda gerekli düzenlemeyi yaptım. Sadece dosyası olan bölümler çalışacak.

Makro ana dosya adına bağımlıydı maliyetprg değişkeni ile değişkene bağlandı. Ana dosya adını isterseniz değiştirebilirsiniz.

 

[baykan_m]

Çok teşekkür ederim tam istediğim gibi olmuş. Elinize yüreğinize sağlık

 

[baykan_m]

Peki aynı şekilde Sabitler sayfasında, b1 hücresinde eğer Örme Dokuma yazıyorsa makro içinde tanımını yaptığım Ring dosya yoluna gidip ilgili dosyayı açtırabilir miyiz?

 

[Asri]

Peki aynı şekilde Sabitler sayfasında, b1 hücresinde eğer Örme Dokuma yazıyorsa makro içinde tanımını yaptığım Ring dosya yoluna gidip ilgili dosyayı açtırabilir miyiz?

İlgili dosya nedir? Ring dosya yolu ne demek?
Ben birşey anlamadım

 

[baykan_m]

Haklısınız biraz kendi işimi karıştırdım sanırım Makro içine yazdığım Ring tanımında dosya yolu var yani dosya adı Ring. D:\Ring\deneme.xlsx gibi düşünün yani. Sabitler sayfasında b1 hücresi örme dokuma ise bu dosyayı açacak diğer durumlarda ise bu dosyayı atlayacak.

 

[Asri]

Haklısınız biraz kendi işimi karıştırdım sanırım Makro içine yazdığım Ring tanımında dosya yolu var yani dosya adı Ring. D:\Ring\deneme.xlsx gibi düşünün yani. Sabitler sayfasında b1 hücresi örme dokuma ise bu dosyayı açacak diğer durumlarda ise bu dosyayı atlayacak.

Anladığım kadar ile kırmızı ile işaretledim.

Sub HAZIRLAMA()
  maliyetprg = ActiveWorkbook.Name

  Bölüm = Worksheets("sabitler").Range("b1")
  Ring = Worksheets("sabitler").Range("C1")
  HareketDosyaAdı = Worksheets("SABİTLER").Range("E3")
  GelmeyenlerDosyaAdı = Worksheets("SABİTLER").Range("E7")
  HiFM = Worksheets("SABİTLER").Range("E4")
  HsFM = Worksheets("SABİTLER").Range("E5")
  GtFM = Worksheets("SABİTLER").Range("E6")
  HareketDosya = "Z:\\Barkodes\Pdks30_sql\Temp\" & Bölüm & "\" & HareketDosyaAdı & ".xlsx"
  HiFMDosya = "Z:\\Barkodes\Pdks30_sql\Temp\" & Bölüm & "\" & HiFM & ".xlsx"
  HsFMDosya = "Z:\\Barkodes\Pdks30_sql\Temp\" & Bölüm & "\" & HsFM & ".xlsx"
  GtFMDosya = "Z:\\Barkodes\Pdks30_sql\Temp\" & Bölüm & "\" & GtFM & ".xlsx"
  GelmeyenlerDosya = "Z:\\Barkodes\Pdks30_sql\Temp\" & Bölüm & "\" & GelmeyenlerDosyaAdı & ".xlsx"
  
[COLOR=Red]  ringdosya = "D:\ring\" & Bölüm & ".xlsx"[/COLOR]
 
 
If dosyavarmi(HareketDosya) Then
    Workbooks.Open HareketDosya
    Cells.Select
    Selection.Copy
    Windows(maliyetprg).Activate
    Sheets("RAPOR - KİŞİ").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows(HareketDosyaAdı).Activate
    ActiveWorkbook.Save
    ActiveWindow.Close
    Range("A1").Select
    Sheets("HAZIRLAMA").Select
 End If
 
If dosyavarmi(GelmeyenlerDosya) Then
    Workbooks.Open GelmeyenlerDosya
    Cells.Select
    Selection.Copy
    Windows(maliyetprg).Activate
    Sheets("RAPOR - İZİNLİ").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows(GelmeyenlerDosyaAdı).Activate
    ActiveWorkbook.Save
    ActiveWindow.Close
    Range("A1").Select
    Sheets("HAZIRLAMA").Select
End If

If dosyavarmi(HiFMDosya) Then
    Workbooks.Open HiFMDosya
    Cells.Select
    Selection.Copy
    Windows(maliyetprg).Activate
    Sheets("RAPOR - MESAİ").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows(HiFM).Activate
    ActiveWorkbook.Save
    ActiveWindow.Close
    Range("A1").Select
    Sheets("HAZIRLAMA").Select
End If
 
If dosyavarmi(HsFMDosya) Then
    Workbooks.Open HsFMDosya
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows(maliyetprg).Activate
    Sheets("RAPOR - MESAİ").Select
    Application.Goto Reference:="R65000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows(HsFM).Activate
    ActiveWorkbook.Save
    ActiveWindow.Close
    Range("A1").Select
    Sheets("HAZIRLAMA").Select
End If

If dosyavarmi(GtFMDosya) Then
    Workbooks.Open GtFMDosya
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows(maliyetprg).Activate
    Sheets("RAPOR - MESAİ").Select
    Application.Goto Reference:="R65000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows(GtFM).Activate
    ActiveWorkbook.Save
    ActiveWindow.Close
    Range("A1").Select
    Sheets("HAZIRLAMA").Select
End If

[COLOR=Red]If dosyavarmi(ringdosya) Then
    Workbooks.Open ringdosya
End If[/COLOR]

End Sub

Function dosyavarmi(dosya)
  Dim ds, a
  Set ds = CreateObject("Scripting.FileSystemObject")
  a = ds.FileExists(dosya)
  If a = True Then
    dosyavarmi = True
  Else
    dosyavarmi = False
  End If
End Function

 

[Korhan Ayhan]

Alternatif olarak dosyanın varlığını DIR komutu ile kontrol edebilirsiniz.

If Dır(Dosya Yolu) = "" Then
     MsgBox "Dosya yok !"
Else
     MsgBox "Dosya var !"
End If

 

[baykan_m]

Sanırım bu değil. Sabitler b1 de örme dokuma yazıyorsa bu dosyayı açacak. Sizin yazdığınız dosya varsa aç yoksa atla gibi oldu sanırım.