Do a simple calculation in word using VBA - vba

Question

I have many documents i need to edit, i have the Version of the document in the Header like "Version #" these documents have different versions, but are all a single integer value. These versions need to +1 so i need to get the number then just add 1 then save.
This is seeming pretty tricky and im not sure its possible. Any Help would be appreciated.
For example.
Old Document
"Version 2"
New Edit
"Version 3"
I can find and replace as i have learned from here.

Answer 1

Try:
Sub UpdateVersions()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String
Dim wdDoc As Document, wdSctn As Section, wdHdFt As HeaderFooter
strDocNm = ActiveDocument.FullName
strFolder = GetFolder: If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
If strFolder & "\" & strFile <> strDocNm Then
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
For Each wdSctn In .Sections
With wdSctn
For Each wdHdFt In .Headers
With wdHdFt
If .LinkToPrevious = False Then
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Version [0-9]{1,}"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
Do While .Find.Found = True
.Text = "Version " & Split(.Text, " ")(1) + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End If
End With
Next
End With
Next
.Close SaveChanges:=True
End With
End If
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Answer 2

This is a quick hack that may do what you wish.
First of all, make sure that you have the Scripting Runtime referenced in the Tools>Project>References menu. Secondly, I have understood that you have more than one document so this lot does everything in a folder.
I have just assumed, for this example, that the folder name is fixed. In Real Life you can modify the code to select the folder and then modify the code to go through sub-folders, but this is (a) a quick hack and (b) out of scope.
Public Sub IncreaseVersionNumbers()
' Make sure that the "Microsoft Scripting Runtime" library is enabled in the Tools>Projects>References
Dim sRootFolder As String
Dim oFSO As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim oFile As Scripting.File
sRootFolder = "C:\_Documents\VersionNumberTest\" ' You can grab this by a Folder Selection dialog box instead
Set oFSO = New Scripting.FileSystemObject
Set oFolder = oFSO.GetFolder(sRootFolder)
For Each oFile In oFolder.Files
If InStr(1, oFile.Name, ".doc", vbTextCompare) > 0 Then
ProcessDocument (sRootFolder & oFile.Name)
End If
Next oFile
End Sub
Private Sub ProcessDocument(sDocument As String)
Dim oDoc As Word.Document
Dim oSection As Word.Section
Dim oRange As Range
Dim sHeaderText As String
On Error Resume Next
Set oDoc = Documents.Open(sDocument)
For Each oSection In oDoc.Sections
Set oRange = oSection.Headers(wdHeaderFooterPrimary).Range
If Not oRange Is Nothing Then
ProcessHeaderRange oRange
End If
Set oRange = oSection.Headers(wdHeaderFooterFirstPage).Range
If Not oRange Is Nothing Then
ProcessHeaderRange oRange
End If
Set oRange = oSection.Headers(wdHeaderFooterEvenPages).Range
If Not oRange Is Nothing Then
ProcessHeaderRange oRange
End If
Next oSection
oDoc.Close wdSaveChanges
End Sub
Private Sub ProcessHeaderRange(oRange As Range)
Dim sText As String, sNewText As String
Dim nPosn As Long, nStart As Long, nEnd As Long
Dim sVersion As String, nVersion As Long
sText = oRange.Text & " "
nPosn = InStr(1, sText, "Version", vbTextCompare)
If nPosn > 0 Then
nStart = InStr(nPosn, sText, " ")
If nStart > 0 Then
nStart = nStart + 1
nEnd = InStr(nStart, sText, " ")
If nEnd > 0 Then
sVersion = Mid$(sText, nStart, nEnd - nStart)
nVersion = Val(sVersion)
nVersion = nVersion + 1
sNewText = Left$(sText, nStart - 1) & Trim$(Str$(nVersion)) & " " & Right$(sText, Len(sText) - nEnd)
sNewText = Left$(sNewText, Len(sNewText) - 1)
oRange.Text = sNewText
End If
End If
End If
End Sub
This is, as I say, a quick hack so it may not work perfectly but, as always, have backups!
This works by going through each of the three possible headers in each possible section of the document. And if it finds a header in a section then it does what you say.
And this version does go above single digit version numbers. But it's a quick hack, as I say and so needs extra work to make it really bullet-proof. Having said that, it's a reasonable start I would think.
Hope that this helps,
Malc