ThisWorkbook.Path & "\" altına makro ile a2 değeri ile klasör aç

[hsayar]

ThisWorkbook.Path & "\" altına makro ile a2 değeri ile klasör aç
komutunu makro ile nasıl yazarım?
Saygılarımla

 

[Orion1]

Aşağıdaki gibi deneyiniz.

Range("A2").value & "\"

 

[hsayar]

yanlış yazdım hocam pardon,
diyelim ki;
a2 de orion
Thiswork.path= c:\deneme

ise ve
c:\deneme\orion yolu yoksa
c:\deneme altına orion klosörünü oluştur...
makro ile denedim ama olmadı

 

[Orion1]

Aşağıdaki gibi deneyiniz.

yol=ThisWorkbook.Path & "\"  & range("A2").value & "\"

 

[hsayar]

hocam klasör oluşturmak istiyorum olmuyor

 

[Orion1]

Aşağıdaki kodları kendi dosyanıza göre ayarlayınız.

Sub FolderExists()
Dim TargetFolder As String
Set fs = CreateObject("Scripting.FileSystemObject")
TargetFolder = "C:\Evren"
If not fs.FolderExists(TargetFolder) Then
ChDir "C:\"
MkDir("Evren")
Else
MsgBox "Klasör var!"
End if
End Sub

 

[hsayar]

Sub FolderExists()
Dim TargetFolder As String
Set fs = CreateObject("Scripting.FileSystemObject")
yol = ThisWorkbook.Path & "\"                       ' mevcut çalışma kitabının olduğu yol
TargetFolder = yol
If Not fs.FolderExists(TargetFolder) Then
ChDir yol
MkDir ("Evren")
Else
MsgBox "Klasör var!"
End If
End Sub

yanlış olan ne?

 

[Orion1]

Aşağıdaki kodu deneyiniz.

Sub FolderExists()
Dim TargetFolder As String
Set fs = CreateObject("Scripting.FileSystemObject")
yol = ThisWorkbook.Path & "\" ' mevcut çalışma kitabının olduğu yol
TargetFolder = yol & "Evren"
If Not fs.FolderExists(TargetFolder) Then
ChDir yol
MkDir ("Evren")
Else
MsgBox "Klasör var!"
End If
End Sub

 

[hsayar]

hocam bu işi yapıp yapamamak ta teddüdüm var
şimdi a2
01/10/2007
önce yıla bakacak aktif çalışma kitabının olduğu klasörde yıl kalsörü varmı yani ....\2007 yoksa oluşturacak
sonra
....\2007\altında ay klasörü varmı yoksa oluşturacak
....\2007\10 klasörü varmı yoksa oluşturacak
ben denemesine denerimde mantığı kavrayamadım

 

[baydeniro]

Özür Dilerim

Konuya pat diye daldım ama bu konuya çok benzeyen ve hep benim kafamı kurcalayan bir sorum var.

Sub KOPYA ()
ADRES = "TEXT;C:\Documents and Settings\cati\Desktop\DATA1022.txt"
With ActiveSheet.QueryTables.Add(Connection:= _
ADRES, Destination:=Range("A1"))
.TextFileOtherDelimiter = ";"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
End Sub

makrosunda DATA1022 dosya adı, hergün değişerek gelecek. Yani yarın DATA1023 olacak ve arandığı katalog altında adı DATA ile başlayan dosya 1 den fazla olmayacak. Bu durumda aranacak dosyanın DATA ile başlayan dosya olması özelliğini makroya verebilmek için kodun nasıl olması gerekir ?

Yardımlarınız için teşekkürler...

 

[hsayar]

yapmak istediğim günlük sayfamdaki verileri bordro sayfasına aktarıyorum şu hali ile çalışıyor

Arşivlemek için taslağa yaz aynı çalışma kitabınının sonuna ggaayy formatında kopyala yapıyorum.

yapmak istediğim ise taslak sayfasını yıl ve ay formatında arşivlemek
yani
Arşivlemek için taslağa yaz aynı çalışma kitabınının bulunduğu klasörün altındaki yy\aa klasöründeki aayyyy çalışma sayfasınınsonuna ggaayy formatında kopyala demek. umarım anlatabildim ilginize şimdiden teşekkür eder saygılar sunarım.

 

[hsayar]

Konuya pat diye daldım ama bu konuya çok benzeyen ve hep benim kafamı kurcalayan bir sorum var.

Sub KOPYA ()
ADRES = "TEXT;C:\Documents and Settings\cati\Desktop\DATA1022.txt"
With ActiveSheet.QueryTables.Add(Connection:= _
ADRES, Destination:=Range("A1"))
.TextFileOtherDelimiter = ";"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
End Sub

makrosunda DATA1022 dosya adı, hergün değişerek gelecek. Yani yarın DATA1023 olacak ve arandığı katalog altında adı DATA ile başlayan dosya 1 den fazla olmayacak. Bu durumda aranacak dosyanın DATA ile başlayan dosya olması özelliğini makroya verebilmek için kodun nasıl olması gerekir ?

Yardımlarınız için teşekkürler...

emin değilim ama dataxxx leri nasıl oluşturduğunuz önemli galiba excel mi? elle mi?

 

[baydeniro]

Teşekkürler hsayar. DATA ile başlayan text dosyalarının rakamsal kısımları tarihe göre dosyayı oluşturan özel bir prgramdan geliyor. Yani manuel veya excel ile ilgili değil.

 

[Orion1]

Konuya pat diye daldım ama bu konuya çok benzeyen ve hep benim kafamı kurcalayan bir sorum var.

Sub KOPYA ()
ADRES = "TEXT;C:\Documents and Settings\cati\Desktop\DATA1022.txt"
With ActiveSheet.QueryTables.Add(Connection:= _
ADRES, Destination:=Range("A1"))
.TextFileOtherDelimiter = ";"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
End Sub

makrosunda DATA1022 dosya adı, hergün değişerek gelecek. Yani yarın DATA1023 olacak ve arandığı katalog altında adı DATA ile başlayan dosya 1 den fazla olmayacak. Bu durumda aranacak dosyanın DATA ile başlayan dosya olması özelliğini makroya verebilmek için kodun nasıl olması gerekir ?

Yardımlarınız için teşekkürler...

Aradığınız dosyaları aşağıdaki gibi sorgulayabilirsiniz.

dosya = "C:\Documents and Settings\cati\Desktop\DATA1022.txt"
If Dir(dosya) = "" Then
    MsgBox "DOSYA YOK"
    Else
    MsgBox "DOSYA VAR"
End If

 

[baydeniro]

Sayın Orino2 ilginiz için çok teşekkür ederim. Bu koddan beklentimiz şu : İlgili yolda buluna ve DATA ile başlayan dosyanın devamı ne olursa olsun bu DATA dosyasını açıp kopyalaması. (Yazılı olan zaten ilgili dosyayı aç, kopyala işini görüyor).

 

[Orion1]

Sayın Orino2 ilginiz için çok teşekkür ederim. Bu koddan beklentimiz şu : İlgili yolda buluna ve DATA ile başlayan dosyanın devamı ne olursa olsun bu DATA dosyasını açıp kopyalaması. (Yazılı olan zaten ilgili dosyayı aç, kopyala işini görüyor).

Aşağıdaki kodu denermisiniz.

Sub KOPYA()
dosya = "C:\Documents and Settings\cati\Desktop\*.txt"
dosyalar = Dir(dosya)
Do While dosyalar <> ""
    If Left(dosyalar, 4) = "DATA" Then
        ADRES = "TEXT;C:\Documents and Settings\cati\Desktop\" & dosyalar
        With ActiveSheet.QueryTables.Add(Connection:= _
        ADRES, Destination:=Range("A1"))
            .TextFileOtherDelimiter = ";"
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
            .Refresh BackgroundQuery:=False
        End With
        dosyalar = Dir
        Exit Sub
    End If
Loop
End Sub

 

[baydeniro]

Orion2 kod, dosyalar Dir(dosya) aşamasında takılıyor.

 

[Orion1]

Orion2 kod, dosyalar Dir(dosya) aşamasında takılıyor.

Oradaki kodu aşağıdaki şekilde deneyiniz.

dosyalar = Dir(dosya)

 

[hsayar]

yapmak istediğim günlük sayfamdaki verileri bordro sayfasına aktarıyorum şu hali ile çalışıyor

Arşivlemek için taslağa yaz aynı çalışma kitabınının sonuna ggaayy formatında kopyala yapıyorum.

yapmak istediğim ise taslak sayfasını yıl ve ay formatında arşivlemek
yani
Arşivlemek için taslağa yaz aynı çalışma kitabınının bulunduğu klasörün altındaki yy\aa klasöründeki aayyyy çalışma sayfasınınsonuna ggaayy formatında kopyala demek. umarım anlatabildim ilginize şimdiden teşekkür eder saygılar sunarım.

hallettim

Sub FolderExistsYil()
Dim TargetFolder As String
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
Set s3 = Sheets("devirler")
Set s4 = Sheets("Aylık")
A = WorksheetFunction.Text(s1.Cells(1, 1), "yyyy")
b = WorksheetFunction.Text(s1.Cells(1, 1), "mmyyyy")
Set fs = CreateObject("Scripting.FileSystemObject")

'---------------Yıl
yol = ThisWorkbook.Path & "\" ' mevcut çalışma kitabının olduğu ve alt klasör açılacak yol
TargetFolder = yol & A         ' Açılacak klasör adı ile birleşimi
If Not fs.FolderExists(TargetFolder) Then        'KONTROL
ChDir yol: MkDir A: MsgBox A & " Klasörü oluşturuldu.!"  'klasöre git, oluşturma mesajı ver
Else
MsgBox A & " Klasörü var!"   'var mesajı var
End If

'---------------Ay
yol = ThisWorkbook.Path & "\" & A ' mevcut çalışma kitabının olduğu yol
TargetFolder = yol & "\" & b
If Not fs.FolderExists(TargetFolder) Then
ChDir yol
MkDir b
MsgBox b & " Klasörü oluşturuldu.!"
Else
MsgBox b & " Klasörü var!"
End If

End Sub

 

[baydeniro]

Orion2 teşekkürler, dosyalar = Dir(dosya) şeklindeki düzeltme çalıştı. Bu aşama güzel oldu. Şu şekilde ki bir düzeltme nasıl yapılabilir. İsmi aynı tanımla başlamayan birden fazla dosya var.

If Left(dosyalar, 4) = "KGID" Then

kısmını 4 ü 2, DATA'yı MT yaparak tekrar makroyu çalıştırdığımda makro kısır döngüye giriyor. Yani aynı katalog altında 1 den fazla ve başlangıç tanımları birbirinden farklı olan dosyalar olunca makronun revize ettiğimizde arzu ettiğimiz dosyanın aktarılması gerçekleşmiyor.