View Single Post
 
Old 08-28-2024, 08:30 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

I've got this, which works for creating the initial file, but comes up with a Run-time error '13': Type Mismatch on this line: version = "V" & Format(CDbl(version) + 0.1, "0.0")

Code:
Sub SaveVersionedDocument()
    Dim doc As Document
    Dim fileName 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 document has been saved
    If doc.Saved Then
        ' Extract existing file name, version, and date
        fileName = Left(doc.Name, Len(doc.Name) - 5) ' Remove ".docx"
        version = Mid(fileName, InStrRev(fileName, "V") + 1)
        currentDate = Format(Date, "dd.mm.yy")
        
        ' Determine if it's a minor update
        minorUpdate = InputBox("Is this a minor update? (Yes/No)") = "Yes"
        
        ' Update version and date
        If minorUpdate Then
            version = Replace(version, ".", "") ' Remove dots
            version = "V" & Format(CDbl(version) + 0.1, "0.0")
        Else
            version = "V" & Format(CDbl(version) + 1, "0")
        End If
    Else
        ' New document: prompt for file name
        fileName = InputBox("Enter a file name (without extension):")
        version = "V1.0"
        currentDate = Format(Date, "dd.mm.yy")
    End If
    
    ' 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
    
    ' Save the document
    doc.SaveAs2 fileName:=folderPath & "\" & fileName & " - " & version & " - " & currentDate & ".docx"
    
    MsgBox "Document saved successfully!"
End Sub
Reply With Quote