• DİKKAT

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

YENİ KLASÖR BULMA

C

comp_wolf

Katılım
15 Eylül 2012
Mesajlar
72
Excel Vers. ve Dili
2010 türkçe
İyi günler,
c:\denem\ konumunun içine
A1 hücresine ne yazarsam o isimde bir klasör açıyorum daha sonra
örnek: A1 hücresinin içine "A1= dosya " yazdım
dosya diye yeni klasör oluşturuyorum daha sonra exel dosyamı o yeni oluşturduğum yani "c\deneme\dosya" klasörü içine nasıl kaydedebilirim.
yardımcı olursanız sevinirim.
şimdiden teşekkür ederim... :)
 
Dosyanızı kayıt ederken yine aynı yolu kullanabilirsiniz.

Kod: 
Yol = "C:\Deneme\" & Range("A1").Value
 
Korhan Ayhan' Alıntı:
Dosyanızı kayıt ederken yine aynı yolu kullanabilirsiniz.

Kod: 
Yol = "C:\Deneme\" & Range("A1").Value
Genişletmek için tıkla ...
Teşekkür ederim ama ben denemenin içine yeni açtığım klasörün adresini buraya nasıl getireceğimi sormuştum. dosyayı kaydetmeyi yapıyorum.
örnek ile anlatayım belki daha anlaşılır olur.

örnek : c\deneme\A5 hücresinde yazan yazı
A5 hücresine yol yazdıysam eğer
c:\deneme\yol\
veyada A5 hücresine bul yazdıysam eğer
c:\deneme\bul\
ben burada bu yol veya bul yazdığım yazıyı kayıt adresini gösterirken nasıl oraya ekleyeceğim.
butona basınca önce A5 hücresindeki ismi c:\deneme\"buraya yazacak"\ sonra da yine A5 hücresindeki ismi dosya ismi yapacak
ben A5 hücresine yazdığım yazıyı yukarıda buraya yazacak kısmına nasıl monte edeceğimi bulmadım ?
umarım anlatabilmişimdir bu sefer.
teşekkür ederim tekrardan yardımcı olduğunuz için.
 
Yazdığınız bölümü pek anlamadım bunu bir dene

Kod: 
yol1 = "C:\Deneme"

If CreateObject("Scripting.FileSystemObject").FolderExists(yol1) = False Then
MkDir yol1
End If

yol2 = "C:\Deneme\" & Range("A1").Value

If CreateObject("Scripting.FileSystemObject").FolderExists(yol2) = False Then
MkDir yol2
End If
 
Ben verdiğim kodu kendinize uyarlayabileceğinizi düşünmüştüm. Demek ki bu aşama da sorun yaşadınız.

Kullandığınız kayıt kodunu paylaşırsanız düzenleme konusunda yardımcı olabiliriz.
 
' klasör oluşturma
Application.ScreenUpdating = False
On Error Resume Next
Dim strPath As String
Dim lCtr As Long
If Cells(1, 1) <> "" And Cells(1, 2) <> "" Then
strPath = Cells(1, 2) & "\" & Cells(1, 1)
arrpath = Split(strPath, "\")
strPath = arrpath(LBound(arrpath)) & "\"
For lCtr = LBound(arrpath) + 1 To UBound(arrpath)
strPath = strPath & arrpath(lCtr) & "\"
If Dir(strPath, vbDirectory) = "" Then
MkDir strPath
End If
Next
End If
Application.ScreenUpdating = True
If Cells(1, 1) <> "" And Cells(1, 2) <> "" Then MsgBox "Klasör açma işlemi BİTTİ.", vbInformation Else MsgBox ("yetersiz veri")
' \\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\ 'G5 hücresinde yazan yazı ile klasör oluşturuldu.
' klasör oluşturma işlemi bitti.
'istediğim klasöre farklı kaydet
Dim dosyam As String
Dim Tarih As String
Tarih = Format(Now, " _DD-MMM-YYYY_hh.mm.ss")
With Sheets("sayfa1")
dosyam = "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\" & .Range("E6").Value & Tarih & ".xlsm"
ActiveWorkbook.SaveAs Filename:=dosyam
End With
MsgBox "SERVİS Kayıt işlemi bitmiştir. İYİ ÇALIŞMALAR...", vbInformation, "Kaydet"
dosyam = vbNullString
'istediğim klasöre farklı kaydet işlemi bitti.
'exelden çıkış
Application.Quit
'exelden çıkış
End If

normalde kodum bu önce yeni klasör oluşturuyorum ama ben daha sonra o yeni oluşturduğum klasörün içine yine aynı isimde dosya kaydetmek istiyorum
yani yolu getiremiyorum
dosyam = "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\buraya yeni yolu getirmek için G5 de yazan yazıyı nasıl getirebilirim. kodun devamı burada olduğu gibi olacak " & .Range("E6").Value & Tarih & ".xlsm"
kırmızı ile yazdığım yere G5 hücresinde yazdığım ismi getirmeye çalışıyorum anlatabildim umarım.
teşekkür ederim yardımlarınız ve ilginiz için.
 
bunu bir dene
Kod: 
yol = "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\" & .Range("g5").Value

If CreateObject("Scripting.FileSystemObject").FolderExists(yol) = False Then
MkDir yol
End If

dosyam =  "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\" & .Range("g5").Value & "\" & .Range("E6").Value & Tarih & ".xlsm"
 
halit3' Alıntı:
bunu bir dene
Kod: 
yol = "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\" & .Range("g5").Value

If CreateObject("Scripting.FileSystemObject").FolderExists(yol) = False Then
MkDir yol
End If

dosyam =  "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\" & .Range("g5").Value & "\" & .Range("E6").Value & Tarih & ".xlsm"
Genişletmek için tıkla ...
teşekkür ederim üstat aradığım sizin yazdığınız kod ile çözdüm, ben dünüşememişim
dosyam = "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\" & .Range("g5").Value & "\" & .Range("E6").Value & Tarih & ".xlsm"
kırmızı ile işaretli yeri ekleyince amacıma ulaşabildim.
şimdi de genel kodlamada aşağıdaki hatayı veriyor.
hata : Bad file name or number (Error 52)
hatalı satır : If Dir(strPath, vbDirectory) = "" Then
bu hatayıda giderirsem programım tamamlanacak.
 
Bu bölümde olmayan bir klasöre işlem yapıldığından kod klasör olmadığından hata alıyorsunuz.

strPath = Cells(1, 2) & "\" & Cells(1, 1)

A1 ve B1 hücrlerinde yazılı olan klasörler den biri yok
 
A1 ve B1 hücrelerinde ne yazıyor.
 
Kodlarınız böyle bir şey olmalı

Rich (BB code): 
Application.ScreenUpdating = False

'buraya oluşacak klasör yolunu yazmalısınız bu kod dosyanın hemen yanına A1 ve B1 hücrelerinde yazılı olan değere göre iç içe klasör oluşturuyor"
klosor = ThisWorkbook.Path

yol3 = klosor & "\" & Cells(1, 2)
If CreateObject("Scripting.FileSystemObject").FolderExists(yol3) = False Then
MkDir yol3
End If
yol4 = yol3 & "\" & Cells(1, 1)

If CreateObject("Scripting.FileSystemObject").FolderExists(yol4) = False Then
MkDir yol4
End If

Dim dosyam As String
Dim Tarih As String
Tarih = Format(Now, " _DD-MMM-YYYY_hh.mm.ss")
With Sheets("sayfa1")
yol = "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\" & Range("g5").Value
If CreateObject("Scripting.FileSystemObject").FolderExists(yol) = False Then
MkDir yol
End If
dosyam = "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\" & Range("g5").Value & "\" & Range("E6").Value & Tarih & ".xlsm"

ActiveWorkbook.SaveAs Filename:=dosyam
End With
MsgBox "SERVİS Kayıt işlemi bitmiştir. İYİ ÇALIŞMALAR...", vbInformation, "Kaydet"
dosyam = vbNullString
'istediğim klasöre farklı kaydet işlemi bitti.
'exelden çıkış
Application.Quit
'exelden çıkış
 
halit3' Alıntı:
A1 ve B1 hücrelerinde ne yazıyor.
Genişletmek için tıkla ...
' klasör oluşturma
Application.ScreenUpdating = False
On Error Resume Next
Dim strPath As String
Dim lCtr As Long
If Range("G6") <> "" And Cells(1, 157) <> "" Then
strPath = Cells(1, 157) & "\" & Range("G6") & " " & Range("G7")
arrpath = Split(strPath, "\")
strPath = arrpath(LBound(arrpath)) & "\"
For lCtr = LBound(arrpath) + 1 To UBound(arrpath)
strPath = strPath & arrpath(lCtr) & "\"
If Dir(strPath, vbDirectory) = "" Then
MkDir strPath
End If
Next
End If
Application.ScreenUpdating = True
If Range("G6") <> "" And Cells(1, 157) <> "" Then MsgBox "Klasör açma işlemi BİTTİ.", vbInformation Else MsgBox ("yetersiz veri")
'istediğim klasöre farklı kaydet
Dim dosyam As String
Dim Tarih As String
Tarih = Format(Now, " _DD-MMM-YYYY_hh.mm.ss")
With Sheets("SAYFA1")
dosyam = "\\10.0.0.10\ortakdata\ARAÇ TAKİBİ\DEVAM EDEN ARAÇLAR\" & .Range("G6").Value & " " & .Range("G7").Value & "\" & .Range("G6").Value & "_" & .Range("G7").Value & Tarih & ".xlsm"
ActiveWorkbook.SaveAs Filename:=dosyam
End With
MsgBox "SERVİS Kayıt işlemi bitmiştir. İYİ ÇALIŞMALAR...", vbInformation, "Kaydet"
dosyam = vbNullString
'istediğim klasöre farklı kaydet işlemi bitti

KODUM BU ŞEKİLDE BAŞKA EXEL DOSYASINDA ÇALIŞIYOR AMA BURADA ÇALIŞMIYOR.
G6 İLE L6 BİRLEŞİK SATIR ONDAN KAYNAKLANABİLİRMİ ?
 
"KODUM BU ŞEKİLDE BAŞKA EXEL DOSYASINDA ÇALIŞIYOR AMA BURADA ÇALIŞMIYOR.
G6 İLE L6 BİRLEŞİK SATIR ONDAN KAYNAKLANABİLİRMİ ? "

burada çalışmıyoru anlamadım kod bir dosyada çalışıyorsa diğer dosyada da çalışır
On Error Resume Next
satırını silin ve kodu f8 ile çalıştırın ve her f8 tuşuna tıkladığınızda kodu adım adım kontrol edin
 
6 nolu mesajdaki kodunuz ile 12 nolu mesajdaki kodunuz farklı
diğer taraftan kodları menülerden ... </> kod bölümünü seçerek oraya kopyalayın.

Alıntı yazımda yazdığı gibi örnek dosyanızın küçük bir bölümünde bire bir aynı olmak kayıtı ile kodlarınızla birlikte ekleyin ondan sonra bakalım
 
üstat hatayı çözdüm çok teşekkür ederim konu için yardımcı olan herkese teşekkür ederim. iyi günler :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst