- Katılım
- 15 Mart 2005
- Mesajlar
- 43,764
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
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
