View Single Post
 
Old 08-28-2024, 10:52 PM
hh vba hh vba is offline Windows 11 Office 2021
Novice
 
Join Date: Aug 2024
Posts: 4
hh vba is on a distinguished road
Default

Ok in case anyone is interested, I finally got this to work:

Code:
Sub SaveVersionedDocument3()
    Dim doc As Document
    Dim fileName As String
    Dim docName As String
    Dim version As String
    Dim currentDate As String
    Dim folderPath As String
    Dim minorUpdate As Boolean
    
    ' Set your document object (assuming you're running this from within Word)
    Set doc = ActiveDocument
      
   
    ' Check if the file name is longer than 16 characters (which means it has been saved before)
        pathlength = Len(doc.Name)
        Debug.Print "pathlength: " & pathlength
        'Update the fileName if it has been saved before
        If pathlength > 16 Then
        ' Extract existing file name, version, and date
        fileName = Left(doc.Name, Len(doc.Name) - 16) ' Remove version and ".docx"
        version = Mid(fileName, InStrRev(fileName, "V") + 1)
        currentDate = Format(Date, "dd.mm.yy")
        docName = Left(doc.Name, Len(doc.Name) - 23) ' Remove ".docx"
        folderPath = ActiveDocument.Path
      
        ' Determine if it's a minor update
        minorUpdate = InputBox("Is this a minor update? (Y/N") = "Y"
        
        'Update version and date
        If minorUpdate Then
            version = "V" & Format(CDbl(version) + 0.1, "0.0")
        Else
            version = "V" & Format(Ceiling(version), "0.0")
        End If
    Else
        ' New document: prompt for file name
        docName = InputBox("Enter a file name (without extension):")
        version = "V1.0"
        currentDate = Format(Date, "dd.mm.yy")
        ' Prompt user to select a folder
        With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            MsgBox "Folder selection canceled. Document not saved."
            Exit Sub
        End If
    End With
    End If
   
    ' Save the document
    doc.SaveAs2 fileName:=folderPath & "\" & docName & " - " & version & " - " & currentDate & ".docx"
    
    MsgBox "Document saved successfully!"
End Sub

Function Ceiling(ByVal num As Double) As Double
    If num = Int(num) Then
        Ceiling = num + 1
    Else
        Ceiling = Int(num) + 1
    End If
End Function
Reply With Quote