Umwandler erweitern (doc. zu docx.)

[DrMinzlauer]

Hallo Zusammen,
da unsere Firme leider noch sehr viele alte Worddateien im einsatz hat, welche aber oft nicht richtig Laden etc.
Es funktioniert in Excel teoretisch genauso, weshalb ich hoffe ihr könnt mir helfen.
habe folgendes Macro erstellt um doc. in docx. umzuwandeln. Dieses Macro funktioniert auch super, allerdings werden Inhalte oft verschoben. Nun habe ich die Lösung für das Problem, weiß allerdings nicht genau wie ich diese Lösung ins Macro bringe.

Wenn ich ein doc. als docx. über speichern unter abspeichern möchte, kann man einen Hacken bei "Kompatibilität mit früheren Versionen von Word beibehalten" setzen. Wenn dieser Hacken gesetzt ist, werden die Inhalte bei der Umwandlung nicht verschoben.

Nun meine Frage, wie kann ich in mein makro einarbeiten, dass beim Speichern immer dieser Hacken gesetzt ist?

Sub ConvertDocsToDocx()
    Dim sourceFolder As String
    Dim targetFolder As String
    Dim fileName As String
    Dim sourceDoc As Document
    Dim targetDoc As Document

    ' Setze den Quell- und Zielordner
    sourceFolder = "C:\Users\sbutz\Desktop\Test docx\"
    targetFolder = "C:\Users\sbutz\Desktop\Test docx neu\"

    ' Überprüfe, ob der Quellordner existiert
    If Dir(sourceFolder, vbDirectory) = "" Then
        MsgBox "Der Quellordner existiert nicht.", vbExclamation
        Exit Sub
    End If

    ' Überprüfe, ob der Zielordner existiert, falls nicht, erstelle ihn
    If Dir(targetFolder, vbDirectory) = "" Then
        MkDir targetFolder
    End If

    ' Schleife durch alle .doc-Dateien im Quellordner
    fileName = Dir(sourceFolder & "*.doc")
    Do While fileName <> ""
        ' Öffne das Quelldokument
        Set sourceDoc = Documents.Open(sourceFolder & fileName)

        ' Konvertiere das Dokument in das .docx-Format
        sourceDoc.Convert
        sourceDoc.SaveAs2 targetFolder & Replace(fileName, ".doc", ".docx"), WdSaveFormat.wdFormatXMLDocument

        ' Schließe das Quelldokument
        sourceDoc.Close

        ' Gehe zum nächsten Dokument
        fileName = Dir
    Loop

    MsgBox "Die Konvertierung wurde abgeschlossen.", vbInformation
End Sub

 

[Macropod]

Sub ConvertDocToDocx()
Application.ScreenUpdating = False
Dim SrcFldr As String, TgtFldr As String, DocSrc As Document, StrNm As String
' Zu einem Ordner navigieren
SrcFldr = GetFolder: If SrcFldr = "" Then Exit Sub: TgtFldr = SrcFldr & " neu\"
' Überprüfe, ob der Zielordner existiert, falls nicht, erstelle ihn
If Dir(TgtFldr, vbDirectory) = "" Then MkDir TgtFldr
' Schleife durch alle .doc-Dateien im Quellordner
StrNm = Dir(StrPth & "\*.doc", vbNormal)
While StrNm <> ""
  ' Öffne das Quelldokument
  Set DocSrc = Documents.Open(fileName:=StrPth & StrNm, AddToRecentFiles:=False, Visible:=False)
  With DocSrc
    If .HasVBProject Then
    ' Konvertiere das Dokument in das .docm-Format
    .SaveAs2 fileName:=TgtFldr & .Name & "m", Fileformat:=wdFormatXMLDocumentMacroEnabled, _
      CompatabilityMode:=wdWord2003, AddToRecentFiles:=False
  Else
    ' Konvertiere das Dokument in das .docx-Format
    .SaveAs2 fileName:=TgtFldr & .Name & "x", Fileformat:=wdFormatXMLDocument, _
      CompatabilityMode:=wdWord2003, AddToRecentFiles:=False
  End If
    ' Schließe das Quelldokument
    .Close False
  End With
  ' Gehe zum nächsten Dokument
  StrNm = Dir()
Wend
Application.ScreenUpdating = True
MsgBox "Die Konvertierung wurde abgeschlossen.", vbInformation
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Wählen Sie einen Ordner", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function