Belirlediğim verilerin klasör, DosyaAdı olarak kaydı

[why35]

Forumlarla aramama rağmen bu konuyla ilgili örneklere ulaşamadım , var fakat varolanlarda klasör nasıl yaratılır belirtilmemiş.O yüzden eğer bu konu daha önce açılmış ise özür dileyerek yapmak istediğim şeyi izah etmek isterim.

Ben sayfamın S8 hanesinde bulunan verinin (06-241 ve her seferinde 1 sayı artan) düğmeye her tıklandığında o hanede bulunan o verinin adıyla bir klasör ve o klasörün içinde aynı isimle excel dosyası açılmasını istiyorum.

Misal C:\Veriyedekleri\06-241\06-241.xls

C:\Veriyedekleri\06-242\06-242.xls
.
.
. ... gibi

Teşekkür ederim
Saygılarımla

 

[szaim]

Kod:

Sub W()
If MsgBox("Yedek almak istiyor musunuz?", vbYesNo + vbQuestion, "Y E D E K L E M E") = vbNo Then Exit Sub
dosya = Range("S8").Value & ".xls"
ThisWorkbook.SaveAs ("C:\" & dosya)
End Sub

 

[Haluk]

Eğer S8 hücresinde 06-240 gibi bir değer varsa, aşağıdaki kod her çalıştırıldığında 06-241, 06-242 ... gibi artarak sizin istediğinizi yapar.

Eğer yanlış anlamadıysam, klasörlerin içinde yeni boş Excel dosyalarının oluşturulmasını istiyorsunuz.

Sub Test()
    Dim No As Long
    Dim strName As String, strFolder As String
    Dim MyWb As Workbook
    No = Mid(Range("S8"), InStr(1, Range("A1"), "-") + 1, 98)
    strName = Replace(Range("S8"), No, No + 1)
    Range("S8") = strName
    If Dir("C:\veriyedekleri", vbDirectory) = Empty Then MkDir "C:\veriyedekleri"
        strFolder = "C:\veriyedekleri\" & strName
        If Dir(strFolder, vbDirectory) = Empty Then
            MkDir strFolder
            If Dir(strFolder & Application.PathSeparator & strName & ".xls") = Empty Then
            Set MyWb = Workbooks.Add
            MyWb.SaveAs strFolder & Application.PathSeparator & strName & ".xls"
            MyWb.Close
        End If
    End If
End Sub

 

[why35]

Eğer S8 hücresinde 06-240 gibi bir değer varsa, aşağıdaki kod her çalıştırıldığında 06-241, 06-242 ... gibi artarak sizin istediğinizi yapar.

Eğer yanlış anlamadıysam, klasörlerin içinde yeni boş Excel dosyalarının oluşturulmasını istiyorsunuz.

Teşekkür ederim ilgi ve yardımlarınızdan dolayı ,
Dosyam boş değil makroyu koyduğum dosyanın yedeği niteliğinde olacak.

 

[Haluk]

....

Dosyam boş değil makroyu koyduğum dosyanın yedeği niteliğinde olacak.

Sub Test2()
    Dim No As Long
    Dim strName As String, strFolder As String
    No = Mid(Range("S8"), InStr(1, Range("A1"), "-") + 1, 98)
    strName = Replace(Range("S8"), No, No + 1)
    Range("S8") = strName
    If Dir("C:\veriyedekleri", vbDirectory) = Empty Then MkDir "C:\veriyedekleri"
        strFolder = "C:\veriyedekleri\" & strName
        If Dir(strFolder, vbDirectory) = Empty Then
            MkDir strFolder
            If Dir(strFolder & Application.PathSeparator & strName & ".xls") = Empty Then
            ThisWorkbook.SaveCopyAs strFolder & Application.PathSeparator & strName & ".xls"
        End If
    End If
End Sub

 

[why35]

vermiş olduğunuz kodları denediğimde

No = Mid(Range("S8"), InStr(1, Range("A1"), "-") + 1, 98)

kısmının hata verdiğini farkettim.
sizce sorun ne olabilir

 

[Haluk]

S8 hücresine ilk önce (bir kereye mahsus) elle 06-240 gibi bir değer yazın.

Daha sonra kodu çalıştırın.

 

[why35]

Ne yazıkki çalışmadı , aynı hata koduyla karşılaştım :agla:

 

[Haluk]

Ekli dosyayı inceleyin ....

Dosyanın yedeği alınırken, bu işi yapan kod modulü ve buton da yedek dosyadan silinmektedir.

 

[why35]

Sayın Haluk Bey

Çok teşekkür ederim zahmet edip dosya haline getirmişsiniz ve tam olarak benim istediğim gibi olmuş ellerinize sağlık fakat
çalıştırdığımda

Set VBComp = ActiveWorkbook.VBProject.VBComponents("ModBackUp")

kısmında "Visiul Basic projesine programlı olarak erişim güvenli değil" hata mesajı çıktı.
Ne yapmam gerek.
Saygılarımla

 

[Haluk]

Excel'de güvenlik ayarlarına bakın....

"Visual Basic Projelerine erişime güven...." gibilerinden birşey olması lazım.

Bunu onaylayın.

 

[why35]

Haluk Bey çok teşekkür ederim yardımlarınızdan dolayı , güvenlik kısmınıda bulup onayladıktan sonra vermiş olduğunuz kod sorunsuz çalıştı.
Gerçekten bu bilgi benim inanılmaz işime yaradı.
Paylaşmış olduğunuz bilginiz,zamanınız ve şahsiyetinize sonsuz saygılar dilerim.
Barış Toğan

 

[Haluk]

Barış bey, rica ederim.

İşinize yaradığına sevindim.

 

[why35]

Merhaba Arkadaşlar ,

Sayın Haluk bey yaklaşık 1 yıl önce bu forumda oluşan sorunuma yanıt bulmuş ve bana gerçekten cok yardımcı olmuştunuz.Şimdi bu konunun devamı olarak , vermiş olduğunuz koda ilave olarak yedek alınırken istediğim sayfaların kayıt edilmesini nasıl saglarım.
Yani bu kod ile varolan sayfanın yeni hali bir klasore teker teker atan sayılarla kopyalanıyordu , ama bu kopyalama işlemi yapılırken ben tüm sayfaları değil "sayfa1" ve "sayfa2" nin kopyalanmasını istiyorum.
Evet aradan uzun zaman geçti anımsamakta zorlanabilirsiniz.Ama bu konuda yardımcı olacağina eminim.Teşekkür ederim.

Saygılarımla