Soru Dosya Yolu ve İsmi Hakkında

[RBozkurt]

İyi çalışmalar.
Alttaki kod ile Word postalarda excelden aldığım verileri ayrı ayrı *.docx dosyası olarak kaydedebiliyorum.
Bu konuda 2 adet problemim var.


1. Olarak:
Burada yapmak istediğim alttaki kod ile kaydedilecek yeri ve işlemi baz alacağı excel yolunun girilmesi lazım.
Ama şöyle bir durum var. Her defasında bu makroyu açıp kodu değiştirmek kullanacak olan arkadaşlarımız için problem olmakta.
Bunu mesela masaüstünde bulunan X klasörü içinde yaptığımızı varsayalım.
2. eklediğim şekilde hangi kodu kullanmamız gerekir?
Genel bir kod olup excel dosyası hangi klasördeyse ordan baz alarak çalışmasını istiyorum.

Const FOLDER_SAVED As String = "C:\Ra\Sonuc\"
Const SOURCE_FILE_PATH As String = "C:\Ra\Ra.xlsx"

Const FOLDER_SAVED As String = "*bulunduğu klasör*\Sonuc\"
Const SOURCE_FILE_PATH As String = "*bulunduğu klasör*\Ra.xlsx"

2. Olarak
Alttaki kod postalarda oluşan sayfaları ayrı ayrı olarak excel de bulunan "KDN" sütunundaki veriye göre kaydetmektedir.
Buradaki KDN (Yani A) sütunu yerine AD_SOYAD (Yani G) sütununu yazarsam oradan veri çekip kaydetmektedir.
2 sütunu birleştirip dosya adı olarak beraber yazdırmak için nasıl yazılması gereklidir.

TargetDoc.SaveAs FOLDER_SAVED & .DataSource.DataFields("KDN").Value & ".docx", wdFormatDocumentDefault

Üstteki kod ile > 1.docx

TargetDoc.SaveAs FOLDER_SAVED & .DataSource.DataFields("AD_SOYAD").Value & ".docx", wdFormatDocumentDefault

Üstteki kod ile > RBozkurt.docx
oluşmaktadır.

Yapılması istenilen 1 - RBozkurt.docx olarak kaydedilmesi. (Yani A ve G sütunundaki verileri birlikte.)



***

Kullanacak olan arkadaşlar için

https://learndataanalysis.org/automate-mail-merge-to-save-each-record-individually-with-word-vba/

Option Explicit

Const FOLDER_SAVED As String = "C:\Ra\Sonuc\"
Const SOURCE_FILE_PATH As String = "C:\Ra\Ra.xlsx"

Sub TestRun()
Dim MainDoc As Document, TargetDoc As Document
Dim dbPath As String
Dim recordNumber As Long, totalRecord As Long

Set MainDoc = ActiveDocument
With MainDoc.MailMerge
    
        '// if you want to specify your data, insert a WHERE clause in the SQL statement
        .OpenDataSource Name:=SOURCE_FILE_PATH, sqlstatement:="SELECT * FROM [Ra$]"
            
        totalRecord = .DataSource.RecordCount
        For recordNumber = 1 To totalRecord
        
            With .DataSource
                .ActiveRecord = recordNumber
                .FirstRecord = recordNumber
                .LastRecord = recordNumber
            End With
            
            .Destination = wdSendToNewDocument
            .Execute False
            
            Set TargetDoc = ActiveDocument
        
            TargetDoc.SaveAs FOLDER_SAVED & .DataSource.DataFields("KDN").Value & ".docx", wdFormatDocumentDefault
        
            TargetDoc.Close False
            
            Set TargetDoc = Nothing
                    
        Next recordNumber

End With

Set MainDoc = Nothing
End Sub

 

[Muzaffer Ali]

Merhaba
Aşağıdaki gibi yapabilşirsiniz.
1-
Const FOLDER_SAVED As String = thisworkbook.path & "\Sonuc\"
Const SOURCE_FILE_PATH As String = thisworkbook.path & "*bulunduğu klasör*\Ra.xlsx"

thisworkbook.path excel dosyasının kayıtlı olduğu klasör adresini verir.
2-
TargetDoc.SaveAs FOLDER_SAVED & .DataSource.DataFields("KDN").Value & " - " & .DataSource.DataFields("AD_SOYAD").Value & ".docx", wdFormatDocumentDefault

 

[RBozkurt]

@dalgalikur teşekkürler hocam yarın ilgili yerleri guncelleyip dönüş yaparım.
Bu problemi çözdükten sonra bu işlemi word dosyasına küçük bir buton olarak ekleyip sonuç almayı planlıyorum.
İlginiz için tekrardan teşekkürler. Kolay gelsin.

 

[RBozkurt]

Merhaba
Aşağıdaki gibi yapabilşirsiniz.
1-
Const FOLDER_SAVED As String = thisworkbook.path & "\Sonuc\"
Const SOURCE_FILE_PATH As String = thisworkbook.path & "*bulunduğu klasör*\Ra.xlsx"

thisworkbook.path excel dosyasının kayıtlı olduğu klasör adresini verir.

1. kod çalışmadı malesef. Makroyu word dosyasına modül kısmına yazıyorum o şekilde çalışıyor.
Değiştirdim fakat malesef olmadı. Yıldızlı yere birşey yazmak gerekiyor mu?

C:\Users\KULLANICIADIMIZ\Desktop\Örnek Uygulama

Bu klasörde 2 adet dosya var.
Şablon.docm (Postalar Word şablonu)
Ra.xlsx (Postalara veri çekilen excel listesi)

Word dosyasını açıp postalardan Ra.xlsx verisi kullanılarak oluşturuluyor.
Normal makro koduna göre sabit bir klasör yazılıp kullanılırsa problem yok.
Ama üstte de belirttim kullanıcı adı olduğu zaman başka bilgisayarda çalışmıyor.
Bu yüzden bu 2 dosyanın olduğu klasörü baz alıp çalışmasını nasıl yapabiliriz?

***

2-
TargetDoc.SaveAs FOLDER_SAVED & .DataSource.DataFields("KDN").Value & " - " & .DataSource.DataFields("AD_SOYAD").Value & ".docx", wdFormatDocumentDefault

Bu kod problemsiz çalıştı. Hatta 2-3 hücreyi de ayrıca ekleme yaptım çok teşekkürler.

 

[RBozkurt]

Elimdeki kodun çalışan son hali budur.
Adres kısmını çözemedim. Buraya farklı bir uygulama olabilir diye düşünüyorum.
Word şablonuma bir adet BUTON ekleyip makroyu çalıştırayım.
Bu butona basınca alttaki satırda hedef klasör kısmını açılır pencere gibi;

" Const FOLDER_SAVED As String = "hedef klasör" " Nereye Kaydedeyim? diye sorsun.
Bende yol göstereyim.


Kaydedilecek yolu gösterdikten sonra 2. satırı yani
" Const SOURCE_FILE_PATH As String = "kaynak dosya" " hedef dosya ney? diye sorsun
Word şablonu için kullanılacak olan excel dosyasını seçtikten sonra alttaki şekilde çalışmaya devam edip işlem sonuçlanmasını istiyorum.

***

Option Explicit

Const FOLDER_SAVED As String = "C:\Ra\Sonuc\"
Const SOURCE_FILE_PATH As String = "C:\Ra\Evrak\Ra.xlsx"

Sub RBozkurt()
Dim MainDoc As Document, TargetDoc As Document
Dim dbPath As String
Dim recordNumber As Long, totalRecord As Long

Set MainDoc = ActiveDocument
With MainDoc.MailMerge
    
        '// if you want to specify your data, insert a WHERE clause in the SQL statement
        .OpenDataSource Name:=SOURCE_FILE_PATH, sqlstatement:="SELECT * FROM [Ra$]"
            
        totalRecord = .DataSource.RecordCount

        For recordNumber = 1 To totalRecord
        
            With .DataSource
                .ActiveRecord = recordNumber
                .FirstRecord = recordNumber
                .LastRecord = recordNumber
            End With
            
            .Destination = wdSendToNewDocument
            .Execute False
            
            Set TargetDoc = ActiveDocument
            
            TargetDoc.SaveAs FOLDER_SAVED & .DataSource.DataFields("KDN").Value & " - " & .DataSource.DataFields("ADA").Value & " - " & .DataSource.DataFields("PARSEL").Value & " - " & .DataSource.DataFields("AD_SYD").Value & " (Uzlaşma)" & ".docx", wdFormatDocumentDefault
            
            TargetDoc.Close False
            
            Set TargetDoc = Nothing
                    
        Next recordNumber

End With

Set MainDoc = Nothing
End Sub

 

[zeynelhug]

dosyanı eklersen yardımcı olmaya çalışırım.

 

[RBozkurt]

Görev dönüşü ekleyecegim. İlgili tüm arkadaşlara çok teşekkürler.

 

[Muzaffer Ali]

Sorun sabit değişkenlerden kaynaklanıyor.
Sabit değişkene dinamik değer atanamaz.
Kodlar aşağıdaki gibi olmalı.

Option Explicit

Dim FOLDER_SAVED As String
Dim SOURCE_FILE_PATH As String

Sub RBozkurt()
    Dim MainDoc As Document, TargetDoc As Document
    Dim dbPath As String
    Dim recordNumber As Long, totalRecord As Long
    
    FOLDER_SAVED = ThisWorkbook.Path & "\Sonuc\"
    SOURCE_FILE_PATH = "\Evrak\Ra.xlsx"
    
    Set MainDoc = ActiveDocument
    With MainDoc.MailMerge
        
            '// if you want to specify your data, insert a WHERE clause in the SQL statement
            .OpenDataSource Name:=SOURCE_FILE_PATH, sqlstatement:="SELECT * FROM [Ra$]"
                
            totalRecord = .DataSource.RecordCount
    
            For recordNumber = 1 To totalRecord
            
                With .DataSource
                    .ActiveRecord = recordNumber
                    .FirstRecord = recordNumber
                    .LastRecord = recordNumber
                End With
                
                .Destination = wdSendToNewDocument
                .Execute False
                
                Set TargetDoc = ActiveDocument
                
                TargetDoc.SaveAs FOLDER_SAVED & .DataSource.DataFields("KDN").Value & " - " & .DataSource.DataFields("ADA").Value & " - " & .DataSource.DataFields("PARSEL").Value & " - " & .DataSource.DataFields("AD_SYD").Value & " (Uzlaşma)" & ".docx", wdFormatDocumentDefault
                
                TargetDoc.Close False
                
                Set TargetDoc = Nothing
                        
            Next recordNumber
    
    End With
    
    Set MainDoc = Nothing
End Sub

 

[RBozkurt]

dosyanı eklersen yardımcı olmaya çalışırım.

Ekliyorum.

Sorun sabit değişkenlerden kaynaklanıyor.
Sabit değişkene dinamik değer atanamaz.
Kodlar aşağıdaki gibi olmalı.

Spoyler: Kodlar

Option Explicit

Dim FOLDER_SAVED As String
Dim SOURCE_FILE_PATH As String

Sub RBozkurt()
    Dim MainDoc As Document, TargetDoc As Document
    Dim dbPath As String
    Dim recordNumber As Long, totalRecord As Long
   
    FOLDER_SAVED = ThisWorkbook.Path & "\Sonuc\"
    SOURCE_FILE_PATH = "\Evrak\Ra.xlsx"
   
    Set MainDoc = ActiveDocument
    With MainDoc.MailMerge
       
            '// if you want to specify your data, insert a WHERE clause in the SQL statement
            .OpenDataSource Name:=SOURCE_FILE_PATH, sqlstatement:="SELECT * FROM [Ra$]"
               
            totalRecord = .DataSource.RecordCount
   
            For recordNumber = 1 To totalRecord
           
                With .DataSource
                    .ActiveRecord = recordNumber
                    .FirstRecord = recordNumber
                    .LastRecord = recordNumber
                End With
               
                .Destination = wdSendToNewDocument
                .Execute False
               
                Set TargetDoc = ActiveDocument
               
                TargetDoc.SaveAs FOLDER_SAVED & .DataSource.DataFields("KDN").Value & " - " & .DataSource.DataFields("ADA").Value & " - " & .DataSource.DataFields("PARSEL").Value & " - " & .DataSource.DataFields("AD_SYD").Value & " (Uzlaşma)" & ".docx", wdFormatDocumentDefault
               
                TargetDoc.Close False
               
                Set TargetDoc = Nothing
                       
            Next recordNumber
   
    End With
   
    Set MainDoc = Nothing
End Sub

İyi haftalar.
Örnek dosyayı ekliyorum. Normal şartlarda dosyayı rardan çıkartıp C dizinine atarsanız ve Tutanak.docm açıp makroyu çalıştırırsanız Sonuç klasörüne gerekli evraklar alınmış olacak.

ThisWorkbook.Path hata veriyor. Bu klasörü bilgisayarın herhangi bir yerinde masaüstü vs. kullanmak istiyorum. C dizinindeki yola bağlı kalmamak adına.

Örnek dosya: https://www.dosyaupload.com/6vzy

 

[RBozkurt]

Son bir adım kaldı yardımcı olabilir misiniz?

 

[Muzaffer Ali]

8. mesajda yazdığım kodlar doğru yalnız siz kodları Word dosyasından çalıştırmak istediğinizi söylemediğiniz ve konuyu da Excel bölümünde açtığınız için Excele göre kod yazdım.
ThisWorkbook.Path yerine thisdocument.path yazarsanız sorun düzelecektir.

 

[RBozkurt]

8. mesajda yazdığım kodlar doğru yalnız siz kodları Word dosyasından çalıştırmak istediğinizi söylemediğiniz ve konuyu da Excel bölümünde açtığınız için Excele göre kod yazdım.
ThisWorkbook.Path yerine thisdocument.path yazarsanız sorun düzelecektir.

@dalgalikur ilginize çok teşekkürler. Sayenizde problemi tamamen çözdüm. Kolay gelsin.


Mesaj 8 de değişecek satır alttaki gibi olacak.

FOLDER_SAVED = ThisDocument.Path & "\Sonuc\"
SOURCE_FILE_PATH = ThisDocument.Path & "\Veriler.xlsx"