Çözüldü Farklı formatta yedek alma

[kemal turan]

Merhaba,
Aşağıdaki kod ile yedek alıyorum.
Dosya xlsm. formatında. Yedek aldığında xlsx. formatında olmasını sağlayacak kod desteği rica ediyorum.
Teşekkür ederim.

Sub YEDEKLE1()

    Dim ds1 As Object
    Set ds1 = CreateObject("Scripting.FileSystemObject")

    If Not ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI") Then
        ds1.CreateFolder "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI"
    End If
    If ThisWorkbook.Path = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI" Then
        Exit Sub
    End If
        Dim yol1 As String
        yol1 = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI\"
        ds1.CopyFile ThisWorkbook.FullName, yol1
   
ThisWorkbook.Close
 
End Sub

 

[muhasebeciyiz]

Sub YEDEKLE1()

    Dim ds1 As Object
    Dim yol1 As String
    Dim yeniDosyaYolu As String
    Dim ws As Workbook
    
    Set ds1 = CreateObject("Scripting.FileSystemObject")
    
    If Not ds1.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI") Then
        ds1.CreateFolder "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI"
    End If
   
    If ThisWorkbook.Path = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI" Then
        Exit Sub
    End If
    
    yol1 = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI\"
    yeniDosyaYolu = yol1 & Replace(ThisWorkbook.Name, ".xlsm", ".xlsx")   
    
    ThisWorkbook.SaveAs Filename:=yeniDosyaYolu, FileFormat:=xlOpenXMLWorkbook 
    
    ThisWorkbook.Close SaveChanges:=False

End Sub

Bu kod, mevcut .xlsm dosyanızı .xlsx formatında belirtilen yedekleme klasörüne kaydedecek ve ardından Excel uygulamasını kapatacaktır. Makrolar .xlsx formatında saklanmadığı için, dosya kaydedildikten sonra makrolar kaybolacaktır. Eğer makroları saklamak isterseniz, yedekleme işlemi sırasında .xlsm formatında saklamayı tercih etmelisiniz.

 

[kemal turan]

Merhaba,
dosya xlsx olarak kayıt ediyor.
Kayıt arasında xlsm yi xlsx formatına kayıt etmek için EVET HAYIR seçeneği çıkıyor.
Ardından eski dosyayı yenisi ile değiştirmek istiyormusunuz seçeneği çıkıyor.
Bu iki sorguyu da evet olarak kayıt için kod ekleme yi de halledersek sevinirim.
Teşekkür ederim

 

[RBozkurt]

Deneyiniz,

    '...Kodlarınız' 
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs Filename:=yeniDosyaYolu, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    '...Kodlarınız'

 

[kemal turan]

Sn. RBozkurt
Çok teşekkür ederim.
Selametle kalınız

 

[RBozkurt]

Sn. RBozkurt
Çok teşekkür ederim.
Selametle kalınız

Önemli değil, kolay gelsin.