• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan ASMET67
  • Başlangıç tarihi Başlangıç tarihi
A

ASMET67

Altın Üye
Katılım
8 Haziran 2007
Mesajlar
410
Excel Vers. ve Dili
Excel 2016
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.

Kod: 
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.
 
ASMET67' Alıntı:
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.

Kod: 
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.
Genişletmek için tıkla ...


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

Hocam birer örnekle açıklamyabilirmisiniz.
 
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
 
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.

baranseren' Alıntı:
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
Genişletmek için tıkla ...
 
ASMET67' Alıntı:
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.
Genişletmek için tıkla ...

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
 
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.
 
Aşağıdaki kodları da deneyebilirsiniz.
Kod: 
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
 
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.
 
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 OLEDB:Database Password="""";Jet OLE" _
, _
"DB:Engine Type=35;Jet OLEDB:Database 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 OLEDB:Don'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
 
Yukarıdaki mesajda verilen kodlar içinde "sour" diye tanımlanan dosya konumunu bu şekilde kullanmanın bir yolu yok mudur?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst