Word16 Makro "Speichern unter"
16.02.2021 08:29:00
Tristan
ich habe eine kurze Frage zu einem Makro bezüglich Word2016. Da viele Foren nicht mehr aktuell sind und ich hier auch Lösungen zu Word-Makros gefunden habe, hoffe ich dies ist in Ordnung, obwohl das eigentlich ein Excel-Forum ist.
Ich habe ein Word-Dokument, welches ich gerne immer wieder original aufrufen möchte, etwas reinschreibe, speichern auf irgendeine Art anwähle und das Dokument dann zum einen unter einem festen Namen mit dem heutigen Datum als .pdf und zum anderen mit einem festen Namen als .txt Datei gespeichert wird. Dabei sollen die beiden Dateien in unterschiedliche Ordner abgelegt werden.
Ist dies generell in einem Schritt umsetzbar, oder muss man dafür Umwege finden und eingehen?
Ansonsten hier mein Code, ist aus alten Foren zusammengeschustert. Der Teil mit dem Namen vorschlagen funktioniert leider generell nicht, heutiges Datum und zweifaches speichern, zum einen pdf, zum anderen txt auch nicht, dafür fehlt Code und vor allem Know-How.
Über Hilfe und Codebeispiele würde ich mich sehr freuen.
Sub FileSave() 'Immer ins Hauptprogramm wechseln und nie das Original überschreiben
FileSaveAs
Exit Sub
ActiveDocument.Save
End Sub
__________________________________________________________________________________
Sub FileSaveAs()
Dim DocName As String
With ActiveDocument
DocName = .CustomDocumentProperties("Bereich") & "_" & _
.CustomDocumentProperties("Abteilung") & "_Version_" & _
CStr(Format(.CustomDocumentProperties("Ausgabedatum"), _
"yyyy_mm_dd"))
End With
Dim strDocName As String
Dim intPos As Integer
' Find position of extension in file name
strDocName = ActiveDocument.Name
intPos = InStrRev(strDocName, ".")
If intPos = 0 Then
' If the document has not yet been saved
' Ask the user to provide a file name
strDocName = InputBox("Please enter the name " & _
"of your document.")
Else
' Strip off extension and add ".txt" extension
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".txt"
End If
' Save file with new extension
ActiveDocument.SaveAs2 FileName:=strDocName, _
FileFormat:=wdFormatText
With Dialogs(wdDialogFileSaveAs)
.Name = DocName
.Show
End With
End Sub