Dosyayı çalıştığı klasörün öncesindeki klasöre kaydetme

[ASMET67]

Selamlar.
Aşağıdaki kod ile dosyanın çalıştığı klasörü bulabiliyorum.
Benim yapmak istediğim dosyanın çalıştığı klasörün bir önceki klasörde bulunan farkli bir klasöre kayıt yaptırmak istiyorum.
Bunu kod ile nasıl yapabilirim.

Dim Yol As String
Yol = ThisWorkbook.Path & "\"

Örnek: C:\ Raporlar klasörü
Bu klasörün altında iki klasörüm var.
c:\raporlar\AnaDosya
c:\Raporlar\Yedekler
Dosya AnaDosya klasörünün içinden çalışıyor. Yedekler klasörüne kayit yaptırmak istiyorum.

 

[baranseren]

Selamlar.
Aşağıdaki kod ile dosyanın çalıştığı klasörü bulabiliyorum.
Benim yapmak istediğim dosyanın çalıştığı klasörün bir önceki klasörde bulunan farkli bir klasöre kayıt yaptırmak istiyorum.
Bunu kod ile nasıl yapabilirim.

Dim Yol As String
Yol = ThisWorkbook.Path & "\"

Örnek: C:\ Raporlar klasörü
Bu klasörün altında iki klasörüm var.
c:\raporlar\AnaDosya
c:\Raporlar\Yedekler
Dosya AnaDosya klasörünün içinden çalışıyor. Yedekler klasörüne kayit yaptırmak istiyorum.

Workbook.saveas komutu ile yaparsınız komutu inceleyin yada filesystemobject ile de manuel kopyalatabilirsiniz.

 

[ASMET67]

Örnek

Hocam birer örnekle açıklamyabilirmisiniz.

 

[baranseren]

Hocam birer örnekle açıklamyabilirmisiniz.

Sub kopyalama()
Excel.ActiveWorkbook.SaveAs("d:\deneme.xls") 'dizin adını siz kendinize göre ayarlayın.
End Sub

 

[baranseren]

Dim Yol As String
Yol = ThisWorkbook.Path & "\"

kısmına ise şunu yapabilirsiniz.

yol değerini split edersiniz diziye alırsınız bu dizinizde \ işareti ile böldürürsünüz.
Dizi boyutu kadar döngü yaparak son dizin adını sildirir kendi istediğinizi yazarsınız bu durumda dizinden bağımsız ayarlamış ve otomatikleştirmiş olursunuz. Eğer bu şarttır derseniz split etme kodunu da yazarım.

Baran SEREN

 

[ASMET67]

Hocam ilgin için teşekkürler.
Acami olduğum hatta "hiç bilgim yok diye bilirim" split edersinizle ne demek istediğini anlayamadım. Bir öernek kod yazarsanı ben uyarlamaya çalışayım.

Dim Yol As String
Yol = ThisWorkbook.Path & "\"

kısmına ise şunu yapabilirsiniz.

yol değerini split edersiniz diziye alırsınız bu dizinizde \ işareti ile böldürürsünüz.
Dizi boyutu kadar döngü yaparak son dizin adını sildirir kendi istediğinizi yazarsınız bu durumda dizinden bağımsız ayarlamış ve otomatikleştirmiş olursunuz. Eğer bu şarttır derseniz split etme kodunu da yazarım.

Baran SEREN

 

[baranseren]

Hocam ilgin için teşekkürler.
Acami olduğum hatta "hiç bilgim yok diye bilirim" split edersinizle ne demek istediğini anlayamadım. Bir öernek kod yazarsanı ben uyarlamaya çalışayım.

Split etmek konusu şu şekilde açıklayayım şimdi sizin dizinin adı

yol = "c:\blabla\altklasor\1\nisan\" olsun

dizim = Split(yol,"\") 'bunu dediğinizde \ lar arasında kalanları diziye parçalar ve değer olarak atarsınız.

' sonra kullanacağınızı şöyle yaparsınız

boyut = ubound(dizim) 'bunun ile dizideki kayıt sayısını alırsınız

for i= 0 to boyut-1
yol = yol & "\" & dizim(i) & "\"
next
' bunu yaparsanız c:\blabla\altklasor\1\ metnine ulaşırsınız.
' yani sizin bi üst dizininize ulaştınız manuel elle girmeden ama

Umarım açıklayıcı olmuştur.
Baran SEREN

 

[seismic]

Enteresan

Sayın baranseren, vermiş olduğunuz örnek kodların sonuna [A1] = yol eklemesini yapıp, kodları çalıştırdığımda A1 hücresinde

c:\blabla\altklasor\1\nisan\\c:\\blabla\\altklasor\\1\\nisan\

yazıyor. Bunun nedeni ne olabilir? Birkaç deneme yaptım ancak mesajınızda belirttiğiniz sonuca ulaşamadım. Belki de sabahın bu saatleri olmasından ve uykusuzluktandır. Bakarsanız sevinirim.

 

[veyselemre]

Aşağıdaki kodları da deneyebilirsiniz.

Sub dene1()
    Dim dizim
    yol = "c:\blabla\altklasor\1\nisan\"
    'yol = ActiveWorkbook.Path
    dizim = Split(yol, "\")
    ReDim Preserve dizim(0 To UBound(dizim) - 1)
    yol = Join(dizim, "\") & Application.PathSeparator
    MsgBox yol 
End Sub

Sub dene2()
    'yol = "c:\blabla\altklasor\1\nisan\"
    yol = ActiveWorkbook.Path
    bul = InStr(StrReverse(yol), "\")
    yol = Left(yol, Len(yol) - bul + 1)
    MsgBox yol
End Sub

Sub dene3()
    Set fso = CreateObject("Scripting.FileSystemObject")
    yol = "c:\blabla\altklasor\1\nisan\"
    'yol = ActiveWorkbook.FullName
    yol = fso.GetParentFolderName(yol) & Application.PathSeparator
    MsgBox yol
End Sub

Sub dene4()
    yol = "c:\blabla\altklasor\1\nisan\"
    dizim = Split(yol, "\")
    yol = ""
    For i = 0 To UBound(dizim) - 2
        yol = yol & dizim(i) & "\"
    Next
    MsgBox yol
End Sub

 

[seismic]

Sub dene4()
yol = "c:\blabla\altklasor\1\nisan\"
dizim = Split(yol, "\")
yol = ""
For i = 0 To UBound(dizim) - 2
yol = yol & dizim(i) & "\"
Next
MsgBox yol
End Sub


Bu kodlar işimi gördü sayın veyselemre, teşekkürler.

 

[seismic]

Aşağıdaki kodları birleştirmeyi denedim ancak başarılı olamadım. Nerede hata yaptığımı da bulamadım açıkcası. İlgilenebilirseniz memnun olurum.

Amaç, dosya açıldığında bir üst dizindeki deneme.xls isimli excel dosyasından dış veri almak. Sorun ise verileri güncellenecek dosyaların bulunduğu klasörlerin farklı olması. Ortak nokta ise veri güncellemesi yapmak için kullanılan deneme.xls dosyasının konumunun diğer dosyalara göre hep bir üst dizinde olması. İkinci sorun, dosyaları içiren klasörü başka bir yere taşındığında aynı hatayı tekrar vermesi. Buna göre kaynak dosyayı bir değişkene atamak en mantıklı yol gibi geldi bana. Buyrun kodlar, umarım derdimi anlatabilmişimdir.

Sub Makro1()
Application.ScreenUpdating = False
Sheets("deneme").Select
yol = ThisWorkbook.Path
dizim = Split(yol, "\")
yol = ""
For i = 0 To UBound(dizim) - 1
yol = yol & dizim(i) & "\"
Next
sour = yol & "deneme.xls"
[c1] = sour ' doğrulama amaçlı kullanılıyor

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=sour;Mode=Share Deny Wri" _
, _
"te;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLE" _
, _
"DB:Engine Type=35;Jet OLEDBatabase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet" _
, _
" OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Loc" _
, _
"ale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Sayfa1$")
.Name = "Hammadde_List"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = sour
.Refresh BackgroundQuery:=False
End With
End Sub

 

[seismic]

Yukarıdaki mesajda verilen kodlar içinde "sour" diye tanımlanan dosya konumunu bu şekilde kullanmanın bir yolu yok mudur?