• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Toplu olarak uyumluluk modu dönüştür

Deneyiniz.

Kod:
Sub Dosya_Uzantisini_Degistir()
    Dim Yol As String, Dosya As String, Kitap As Object, Uygulama As Object, FSO As Object, Zaman As Double
    
    Zaman = Timer
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Uygulama = CreateObject("Word.Application")
    
    Yol = "C:\Users\Korhan\Desktop\Dosyalar\"
    Dosya = Dir(Yol & "*.doc*", vbDirectory)
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    While Dosya <> ""
        Set Kitap = Uygulama.Documents.Open(Yol & Dosya, ReadOnly:=True)
        Yeni_Kitap = Replace(Kitap.Name, "." & FSO.GetExtensionName(Yol & Dosya), "")
        Kitap.SaveAs2 Filename:=Yol & Yeni_Kitap & ".docx", FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15
        Kitap.Close
        Dosya = Dir
    Wend
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Sayın Korhan Bey çok teşekkür ediyorum, ellerinize sağlık tam istediğim gibi oldu.

Hayırlı çalışmalar, hayırlı geceler diliyorum.
 
Geri
Üst