Bir klasörün içinde dosya olmaması durumunda makronun devam etmesi Hk.

Ö

Öz1.618

Katılım
12 Şubat 2019
Mesajlar
115
Excel Vers. ve Dili
Vera. 10 Dil Türkçe
Merhaba,

Diyelim benim A, B, ve C adında 3 dosyam var. Benim yapmak istediğim A ve B doyalarını C dosyasına kaydetmek. A ve B dosyası içersindeki sütun başlıkları aynı fakat C dosyasındaki sütun başlıkları aynı olmadığı için bir takım sütun eşitleme işlemleri de yapıyorum bu dosyalara vba içerisinde.

Aşağıda kodlarını paylaştığım vba dan bir klasör içerisinde yer alan dosyayı açıyorum(A dosyası) fakat bu klasör içerisinde açmak istediğim dosya yoksa makronun hata vermesin istemiyorum. Makro dosyayı bulamadıysa (A dosyasını bulamadıysa) diğer dosyaya gitsin istiyorum (B dosyasına gitsin istiyorum.) eğer 2. dosyayı da bulamadıysa o zam makro son bulsun istiyorum. Çünkü her hafta her iki dosya başka bir makro çalıştırınca ayrıştırmadan gelmeyebiliyor. Yani bir hafta hem A hem B dosyası varken başka bir hafta bunlardan birisi olmababiliyor. O yüzden makro bu 2 dosyadan birisini göremeyince hata vermesin istiyorum. Hangi dosya yoksa o alanı boş geçsin istiyorum.
Konu hakkında yardımlarınızı rica ederim.

Sub Madde1 ()

'A Dosyası

xPath = Application.ActiveWorkbook.Path
Workbooks.Open (xPath & "\" & "S_Veriler" & "\" & "Satış Özeti.xlsx")

ActiveSheet.Columns("B:B").Select
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"

ActiveSheet.Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Range("Z1").Select
ActiveCell.FormulaR1C1 = "S_FLAG"
ActiveSheet.Columns("Z:Z").EntireColumn.AutoFit



'B dosyası

xPath = Application.ActiveWorkbook.Path
Workbooks.Open (xPath & "\" & "SS_Veriler" & "\" & "Şube Açılışları.xlsx")
 
E

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Öz1.618' Alıntı:
Merhaba,

Diyelim benim A, B, ve C adında 3 dosyam var. Benim yapmak istediğim A ve B doyalarını C dosyasına kaydetmek. A ve B dosyası içersindeki sütun başlıkları aynı fakat C dosyasındaki sütun başlıkları aynı olmadığı için bir takım sütun eşitleme işlemleri de yapıyorum bu dosyalara vba içerisinde.

Aşağıda kodlarını paylaştığım vba dan bir klasör içerisinde yer alan dosyayı açıyorum(A dosyası) fakat bu klasör içerisinde açmak istediğim dosya yoksa makronun hata vermesin istemiyorum. Makro dosyayı bulamadıysa (A dosyasını bulamadıysa) diğer dosyaya gitsin istiyorum (B dosyasına gitsin istiyorum.) eğer 2. dosyayı da bulamadıysa o zam makro son bulsun istiyorum. Çünkü her hafta her iki dosya başka bir makro çalıştırınca ayrıştırmadan gelmeyebiliyor. Yani bir hafta hem A hem B dosyası varken başka bir hafta bunlardan birisi olmababiliyor. O yüzden makro bu 2 dosyadan birisini göremeyince hata vermesin istiyorum. Hangi dosya yoksa o alanı boş geçsin istiyorum.
Konu hakkında yardımlarınızı rica ederim.

Sub Madde1 ()

'A Dosyası

xPath = Application.ActiveWorkbook.Path
Workbooks.Open (xPath & "\" & "S_Veriler" & "\" & "Satış Özeti.xlsx")

ActiveSheet.Columns("B:B").Select
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"

ActiveSheet.Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Range("Z1").Select
ActiveCell.FormulaR1C1 = "S_FLAG"
ActiveSheet.Columns("Z:Z").EntireColumn.AutoFit



'B dosyası

xPath = Application.ActiveWorkbook.Path
Workbooks.Open (xPath & "\" & "SS_Veriler" & "\" & "Şube Açılışları.xlsx")
Genişletmek için tıkla ...
Bu şekilde deneyiniz.

Kod: 
Sub Madde1()

'A Dosyası

XPath = Application.ActiveWorkbook.Path

Set ds = CreateObject("Scripting.FileSystemObject")

If ds.FileExists(XPath & "\" & "S_Veriler" & "\" & "Satış Özeti.xlsx") Then

    Workbooks.Open (XPath & "\" & "S_Veriler" & "\" & "Satış Özeti.xlsx")
    ActiveSheet.Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy"
    
    ActiveSheet.Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.Range("Z1").Select
    ActiveCell.FormulaR1C1 = "S_FLAG"
    ActiveSheet.Columns("Z:Z").EntireColumn.AutoFit
    
End If

'B dosyası
XPath = Application.ActiveWorkbook.Path
If ds.FileExists(XPath & "\" & "SS_Veriler" & "\" & "Şube Açılışları.xlsx") Then
    Workbooks.Open (XPath & "\" & "SS_Veriler" & "\" & "Şube Açılışları.xlsx")
End If

End Sub
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,420
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Bir dosyanın var olu olmadığını aşağıdaki kodda olduğu gibi öğrenebilirsiniz.
Kendi kodlarınıza uyarlarsınız.

Kod: 
Sub test()
    If Dir("c:\Test\DosyamınAdı.xlsm") = "" Then
        MsgBox "Aradığınız dosya bulunamıyor."
    Else
        MsgBox "Bu dosya mevcut."
    End If
End Sub
 
Ö

Öz1.618

Katılım
12 Şubat 2019
Mesajlar
115
Excel Vers. ve Dili
Vera. 10 Dil Türkçe
EmrExcel16' Alıntı:
Bu şekilde deneyiniz.

Kod: 
Sub Madde1()

'A Dosyası

XPath = Application.ActiveWorkbook.Path

Set ds = CreateObject("Scripting.FileSystemObject")

If ds.FileExists(XPath & "\" & "S_Veriler" & "\" & "Satış Özeti.xlsx") Then

    Workbooks.Open (XPath & "\" & "S_Veriler" & "\" & "Satış Özeti.xlsx")
    ActiveSheet.Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy"
  
    ActiveSheet.Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.Range("Z1").Select
    ActiveCell.FormulaR1C1 = "S_FLAG"
    ActiveSheet.Columns("Z:Z").EntireColumn.AutoFit
  
End If

'B dosyası
XPath = Application.ActiveWorkbook.Path
If ds.FileExists(XPath & "\" & "SS_Veriler" & "\" & "Şube Açılışları.xlsx") Then
    Workbooks.Open (XPath & "\" & "SS_Veriler" & "\" & "Şube Açılışları.xlsx")
End If

End Sub
Genişletmek için tıkla ...
Emre Bey çok teşekkür ederim.
Bir konuda daha bana destek olursanız sevinirim.
C dosyasında z sütununda s_flag yazıyorsa c dosyasına sütun ekleme işlemi yapmıyacağım. Çünkü bu şu anlama geliyor demek. A dosyasını açmışım ve A dosyasıyla C dosyasını eşitlerken z sütununa s_flag eklemişim ve dosyayı kapatmışım.
C dosyasını vba dan ikini kez açarsam z sütununda s_flag yazıyorsa direk end if e insin istiyorum kodun.
Aşağıdaki kod üzerinden yardımcı olur musunuz bana.

C dosyası = Şube Durum.xlsx

Workbooks("Rutin - S Kontrol Başlıkları.xlsm").Activate
Path = Application.ActiveWorkbook.Path
Workbooks.Open (xPath & "\" & "Rutin_Datalar" & "\" & "Şube Durum.xlsx")
ActiveSheet.Range("U1").Select
ActiveCell.FormulaR1C1 = "Platform Tipi"
ActiveSheet.Range("V1").Select
ActiveCell.FormulaR1C1 = "Kart Tipi"
ActiveSheet.Range("W1").Select
ActiveCell.FormulaR1C1 = "Süreç"
ActiveSheet.Range("X1").Select
ActiveCell.FormulaR1C1 = "s.key"
ActiveSheet.Range("Y1").Select
ActiveCell.FormulaR1C1 = "Müşteri Yaş"
ActiveSheet.Range("Z1").Select
ActiveCell.FormulaR1C1 = "S FLAG"

ActiveSheet.Range("T1").Select
Selection.Copy
ActiveSheet.Range("U1:Z1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
 
Ö

Öz1.618

Katılım
12 Şubat 2019
Mesajlar
115
Excel Vers. ve Dili
Vera. 10 Dil Türkçe
Öz1.618' Alıntı:
Emre Bey çok teşekkür ederim.
Bir konuda daha bana destek olursanız sevinirim.
C dosyasında z sütununda s_flag yazıyorsa c dosyasına sütun ekleme işlemi yapmıyacağım. Çünkü bu şu anlama geliyor demek. A dosyasını açmışım ve A dosyasıyla C dosyasını eşitlerken z sütununa s_flag eklemişim ve dosyayı kapatmışım.
C dosyasını vba dan ikini kez açarsam z sütununda s_flag yazıyorsa direk end if e insin istiyorum kodun.
Aşağıdaki kod üzerinden yardımcı olur musunuz bana.

C dosyası = Şube Durum.xlsx

Workbooks("Rutin - S Kontrol Başlıkları.xlsm").Activate
Path = Application.ActiveWorkbook.Path
Workbooks.Open (xPath & "\" & "Rutin_Datalar" & "\" & "Şube Durum.xlsx")
ActiveSheet.Range("U1").Select
ActiveCell.FormulaR1C1 = "Platform Tipi"
ActiveSheet.Range("V1").Select
ActiveCell.FormulaR1C1 = "Kart Tipi"
ActiveSheet.Range("W1").Select
ActiveCell.FormulaR1C1 = "Süreç"
ActiveSheet.Range("X1").Select
ActiveCell.FormulaR1C1 = "s.key"
ActiveSheet.Range("Y1").Select
ActiveCell.FormulaR1C1 = "Müşteri Yaş"
ActiveSheet.Range("Z1").Select
ActiveCell.FormulaR1C1 = "S FLAG"

ActiveSheet.Range("T1").Select
Selection.Copy
ActiveSheet.Range("U1:Z1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Genişletmek için tıkla ...
Emre bey aşağıdaki kodla problemi çözdüm teşekkür ederim :)

Workbooks("Rutin - S Kontrol Başlıkları.xlsm").Activate
Path = Application.ActiveWorkbook.Path
Workbooks.Open (xPath & "\" & "Rutin_Datalar" & "\" & "Şube Durum.xlsx")

If ActiveSheet.Range("Z1") = "" Then
ActiveSheet.Range("U1").Select
ActiveCell.FormulaR1C1 = "Platform Tipi"
bla
bla
bla
bla
End If
 
E

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Öz1.618' Alıntı:
Emre bey aşağıdaki kodla problemi çözdüm teşekkür ederim :)

Workbooks("Rutin - S Kontrol Başlıkları.xlsm").Activate
Path = Application.ActiveWorkbook.Path
Workbooks.Open (xPath & "\" & "Rutin_Datalar" & "\" & "Şube Durum.xlsx")

If ActiveSheet.Range("Z1") = "" Then
ActiveSheet.Range("U1").Select
ActiveCell.FormulaR1C1 = "Platform Tipi"
bla
bla
bla
bla
End If
Genişletmek için tıkla ...
Rica ederim , iyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst