Hocalarım ve arkadaşlar gömülü word şablonları mevcut butona tıklayınca 4 adet şablonu şablonlar klasörüne kaydetmesini istiyorum fakat 2 tanesini kaydediyor hata veriyor yardımcı olabilirmisiniz

Hayırlı bayramlar

Dim NewDoc As String
Dim DocPath(10) As String
Dim K As Integer
'----------------------------
DocPath(1) = CurrentProject.path & "\Şablonlar" & "\uzlastirma_raporu.dot"
DocPath(2) = CurrentProject.path & "\Şablonlar" & "\Teklif_Formu.dot"
DocPath(3) = CurrentProject.path & "\Şablonlar" & "\Posta_Tevdi_Listesi.dot"
DocPath(4) = CurrentProject.path & "\Şablonlar" & "\Tebligat_Zarfı.dot"

Call Sablon_Klasor_Kontrol 'şablonlar klasörü kontrol edilip oluştutuluyor-----
'----------------Şabloon Oluşturuluyor ----------------------------------------

'-(1)----------------------------Rapor_Tebligat_Şablonu Oluşturuluyor----------------
   
   
With Me.Rapor_Tebligat_Şablon   'formdaki oluşturulacak şablon ismi --------------------
   .Class = "Word.Document"
   .Verb = acOLEVerbOpen
   .Action = acOLEActivate
   .Object.Application.Documents.Item(1).SaveAs DocPath(1)
   .Object.Application.Quit
End With

'-(2)----------------------------Teklif_Formu_Şablonu Oluşturuluyor----------------

With Me.Teklif_Formu_Şablon   'formdaki oluşturulacak şablon ismi --------------------
   .Class = "Word.Document"
   .Verb = acOLEVerbOpen
   .Action = acOLEActivate
   .Object.Application.Documents.Item(1).SaveAs DocPath(2)
   .Object.Application.Quit
End With

'-(3)----------------------------Posta_Tevdi_Listesi_Şablonu Oluşturuluyor----------------
   
With Me.Posta_Tevdi_şablon   'formdaki oluşturulacak şablon ismi --------------------
   .Class = "Word.Document"
   .Verb = acOLEVerbOpen
   .Action = acOLEActivate
   .Object.Application.Documents.Item(1).SaveAs DocPath(3)
   .Object.Application.Quit
End With
'-(4)----------------------------Tebligat_Zarfı_Listesi_Şablonu Oluşturuluyor----------------
    With Me.Tebligat_Zarfı_şablon   'formdaki oluşturulacak şablon ismi --------------------
   .Class = "Word.Document"
   .Verb = acOLEVerbOpen
   .Action = acOLEActivate
   .Object.Application.Documents.Item(1).SaveAs DocPath(4)
   .Object.Application.Quit
End With

'--------------------------------------------------------



End Sub
Sub Sablon_Klasor_Kontrol()
On Error GoTo Şablon_klasör__Hata

'--------Klasör oluşturma değerleri-----------
Dim GDizin_SBL As String
Dim GKlasör_SBL As String
Dim klasör_ismi As String
'---------------------------------------------
'--------------Klasör ismi Belirleniyor-------------
klasör_ismi = "Şablonlar"

'---------------Klasör oluşturuluyor-------------
GDizin_SBL = CurrentProject.path & "\" & klasör_ismi
GKlasör_SBL = Len(Dir(GDizin_SBL, vbDirectory))
 
'---------------- Klasör Varmı Kontrolü Ediliyor -------------------
If GKlasör_SBL = 0 Then
MkDir GDizin_SBL
End If



Şablon_klasör__Hata:

If err.Number = 3011 Then
MsgBox "Klasör oluşturmada hata", , "KLASÖR OLUŞTURULAMADI": GoTo Klasör_Muhtıra_Çıkış
End If

Klasör_Muhtıra_Çıkış:

End Sub

4 ünü sırası ile açtırabildim fakat bir sorun oluştu açtırıp kaydettirip kapatmaya çalışınca kaydetme işlemini yapmadan kapatıyor ve hata veriyor (ağbağlantısı hatası gibi) birde gömülü şablonu aktif hale getirip bilgileri şablona gönderdikten ve yeni isimle kaydettirdikten sonra şablon da önceki veriler hala kalıyor 2. Verileri gönderdiğimde eski verilerle beraber aynı yazıyor verileri gönderdikten sonra gömülü şablonu nasıl boş kalmasını sağlayabilirim yardımcı olursanız sevinirim saygıkar

Merhaba, aktarma işlemi için kullandığınız 4 blok halindeki kodları ayrı ayrı sub olarak yazıp çalıştırmayı deneyin. 

Her biri ayrı ayrı çalışırsa ve kod çalıştıktan sonra uzlastirma_raporu.dot isimli belge oluşturulunca sonraki koda geçecek şekilde tasarlanırsa sorun çıkmaz