Kod içindeki klasör yolunu düzenlemek

[Mehmet Sait]

Merhaba,

Ekli kod ile masaüstünde Üretim Vardiya Raporları klasörünü oluşturup, raporu bu klasöre kaydediyor. Birden fazla rapor olduğu için tek klasörde "Raporlar" toplamak istiyorum. Masaüstüne Raporlar/ Üretim Vardiya Raporları

Şu kısımda nasıl bir değişim yapmalıyım ? Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _ Raporlar


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

Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & Year(Date) & " Üretim Vardiya Raporları"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & Year(Date) & " Üretim Vardiya Raporları" & Application.PathSeparator & Format(Date, "mmmm yyyy") & " - Üretim Vardiya Raporları"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
 
    'If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
 
    Set Uygulama = CreateObject("Outlook.Application")
    Set Yeni_Mail = Uygulama.CreateItem(0)
 
    Dosya_Adi = S1.Range("G3").Value & " " & S1.Range("G5").Value & ".pdf"

    S1.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Yol & "\" & Dosya_Adi, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

 

[dost]

Merhaba,

Aşağıda Yol'un nasıl oluştuğunu açıklamaya çalıştım. Buna göre uyarlarsınız.

Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & Year(Date) & " Üretim Vardiya Raporları"
          
    'Yukarıdaki Yol değişkenine atadığınız kod, aşağıdaki şekide oluşan parçaların birleşmesinden oluşur.
          
    'CreateObject("WScript.Shell").SpecialFolders("Desktop")  = C:\Users\xxxxx\Desktop     xxxxx= Kullanıcı adı
    'Application.PathSeparator = "\"
    'Year(Date) = Yıl  '" Üretim Vardiya Raporları"
  
  Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & Year(Date) & " Üretim Vardiya Raporları" & Application.PathSeparator & Format(Date, "mmmm yyyy") & " - Üret "
    
    
  'Yukarıdaki Yol değişkenine atadığınız kod, aşağıdaki şekide oluşan parçaların birleşmesinden oluşur.
          
    'CreateObject("WScript.Shell").SpecialFolders("Desktop")  = C:\Users\xxxxx\Desktop     xxxxx= Kullanıcı adı
    'Application.PathSeparator = "\"
    'Year(Date) = Yıl " Üretim Vardiya Raporları"
    'Application.PathSeparator = "\"
    'Format(Date, "mmmm yyyy") & " - Üret " Tarihi formattaki gibi  yazıp yanına  " - Üret " eklenir

 

[Mehmet Sait]

Merhaba,

Aşağıda Yol'un nasıl oluştuğunu açıklamaya çalıştım. Buna göre uyarlarsınız.

Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & Year(Date) & " Üretim Vardiya Raporları"
         
    'Yukarıdaki Yol değişkenine atadığınız kod, aşağıdaki şekide oluşan parçaların birleşmesinden oluşur.
         
    'CreateObject("WScript.Shell").SpecialFolders("Desktop")  = C:\Users\xxxxx\Desktop     xxxxx= Kullanıcı adı
    'Application.PathSeparator = "\"
    'Year(Date) = Yıl  '" Üretim Vardiya Raporları"
 
  Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & Year(Date) & " Üretim Vardiya Raporları" & Application.PathSeparator & Format(Date, "mmmm yyyy") & " - Üret "
   
   
  'Yukarıdaki Yol değişkenine atadığınız kod, aşağıdaki şekide oluşan parçaların birleşmesinden oluşur.
         
    'CreateObject("WScript.Shell").SpecialFolders("Desktop")  = C:\Users\xxxxx\Desktop     xxxxx= Kullanıcı adı
    'Application.PathSeparator = "\"
    'Year(Date) = Yıl " Üretim Vardiya Raporları"
    'Application.PathSeparator = "\"
    'Format(Date, "mmmm yyyy") & " - Üret " Tarihi formattaki gibi  yazıp yanına  " - Üret " eklenir

Merhaba,

İlginize teşekkür ederim.

Uyarlama yapamadım. " = C:\Users\xxxxx\Desktop xxxxx= Kullanıcı adı " kısmında hata veriyor ve " \ " işaretliyor.
Amacım oluşturulan klasörü bir üst klasörde toplamak.
Birden fazla bilgisayarda kullanılcağı için her bilgisayarda kodlarda ayrıca kullanıcı adı belirtmek zor olacaktır.


Teşekkür ederim.

 

[dost]

Merhaba,

Aşağıdaki kod senin masa üstünde aşağıdaki şekilde bir klasör oluşturur, klasör varsa geçer. 'xxxxxx = senin kullanıcı adın
C:\Users\xxxxxx\Desktop\Üretim Vardiya Raporları

İstediğin bu mu?

Eğer C:\Users\xxxxxx\Desktop\Üretim Vardiya Raporları\ şekide istersen kodun sonuna &Application.PathSeparator eklersin.

Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & "Üretim Vardiya Raporları"
If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

On Error Resume Next
....................

 

[Mehmet Sait]

Merhaba,

Aşağıdaki kod senin masa üstünde aşağıdaki şekilde bir klasör oluşturur, klasör varsa geçer. 'xxxxxx = senin kullanıcı adın
C:\Users\xxxxxx\Desktop\Üretim Vardiya Raporları

İstediğin bu mu?

Eğer C:\Users\xxxxxx\Desktop\Üretim Vardiya Raporları\ şekide istersen kodun sonuna &Application.PathSeparator eklersin.

Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & "Üretim Vardiya Raporları"
If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

On Error Resume Next
....................

Merhaba,

Kullanıcı adı belirtmek zorunda kalmadan, masa üstüne C:\Desktop\Raporlar\Üretim Vardiya Raporları\ şeklinde olabilir mi?

 

[Korhan Ayhan]

İki farklı kod öneriyorum. Kendi kodlarınıza uyarlarsınız.

1. Alternatif;

Option Explicit

Sub Test()
    Dim Yol As String
   
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & "Raporlar" & _
          Application.PathSeparator & "Üretim Vardiya Raporları" & Application.PathSeparator
   
    If Dir(Yol, vbDirectory) = "" Then
        Shell ("cmd /c mkdir """ & Yol & """")
    End If
End Sub

2. Alternatif;

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
#Else
    Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
#End If

Public Function MakeFullDir(X_Path As String) As Boolean
    If Right(X_Path, 1) <> "\" Then X_Path = X_Path & "\"
    MakeFullDir = MakeSureDirectoryPathExists(X_Path)
End Function

Sub Test()
    Dim Yol As String
   
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & "Raporlar" & _
          Application.PathSeparator & "Üretim Vardiya Raporları" & Application.PathSeparator
   
    Call MakeFullDir(Yol)
End Sub

 

[Mehmet Sait]

İki farklı kod öneriyorum. Kendi kodlarınıza uyarlarsınız.

1. Alternatif;

Option Explicit

Sub Test()
    Dim Yol As String
  
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & "Raporlar" & _
          Application.PathSeparator & "Üretim Vardiya Raporları" & Application.PathSeparator
  
    If Dir(Yol, vbDirectory) = "" Then
        Shell ("cmd /c mkdir """ & Yol & """")
    End If
End Sub

2. Alternatif;

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
#Else
    Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
#End If

Public Function MakeFullDir(X_Path As String) As Boolean
    If Right(X_Path, 1) <> "\" Then X_Path = X_Path & "\"
    MakeFullDir = MakeSureDirectoryPathExists(X_Path)
End Function

Sub Test()
    Dim Yol As String
  
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & "Raporlar" & _
          Application.PathSeparator & "Üretim Vardiya Raporları" & Application.PathSeparator
  
    Call MakeFullDir(Yol)
End Sub

Hocam, 1. Alternatifi kullandım, gayet güzel oldu. Teşekkür ederim.