Why only one subroutine runs in code below

[tinkeringwithvba]

Please see the code below. I am trying to call two subroutines in excel vba with this code. One to create a new version of current file with a V1 naming convention.. other to save a log of who used the file.

Now as soon as I open the excel the log subroutine runs and I see log file created/ entries added but the create version subroutine doesn't run. When I run it like a macro then both the subroutine run.

What am I doing wrong here.. I want both routines to run when I press save in excel. please help!!


Sub SaveNewVersion_Excel()

Call Workbook_Open

Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long

TestStr = ""
Saved = False
x = 2

'Version Indicator (change to liking)
VersionExt = "_v"

'Pull info about file
On Error GoTo NotSavedYet
myPath = ActiveWorkbook.FullName
myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
FolderPath = Left(myPath, InStrRev(myPath, "\"))
SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
On Error GoTo 0

'Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If

'Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & SaveExt
Exit Sub
End If

'Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
Saved = True
Else
x = x + 1
End If
Loop

'New version saved
MsgBox "New file version saved (version " & x & ")"

Exit Sub

'Error Handler
NotSavedYet:
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"

End Sub




Function FileExist(FilePath As String) As Boolean


Dim TestStr As String

'Test File Path (ie "C:\Users\tinker\Desktop\Status_Reports\Version\Metrics_Mar15.xlsm")
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0

'Determine if File exists
If TestStr = "" Then
FileExist = False
Else
FileExist = True
End If
End Function


'Create a log
Private Sub Workbook_Open()
Open "C:\Users\tinker\Desktop\Status_Reports\Version\SYSTEM.log" For Append As #1
Print #1, Application.UserName, Now
Close #1
MsgBox "log created"

End Sub

 

[sericom]

'Create a log
Private Sub Workbook_Open()
Open "C:\Users\tinker\Desktop\Status_Reports\Version\SYSTEM.log" For Append As #1
Print #1, Application.UserName, Now
Close #1
MsgBox "log created"

End Sub

That's the only code that runs on workbook open, you'd need to add a call your other sub if you want it to run.
If you want them both to happen on save then replace your workbook code with the following

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Open "C:\Users\tinker\Desktop\Status_Reports\Version\SYSTEM.log" For Append As #1
    Print #1, Application.UserName, Now
    Close #1
    MsgBox "log created"

    Dim FolderPath As String
    Dim myPath As String
    Dim SaveName As String
    Dim SaveExt As String
    Dim VersionExt As String
    Dim Saved As Boolean
    Dim x As Long

    TestStr = ""
    Saved = False
    x = 2

'Version Indicator (change to liking)
    VersionExt = "_v"

'Pull info about file
    On Error GoTo NotSavedYet
    myPath = ActiveWorkbook.FullName
    myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
    FolderPath = Left(myPath, InStrRev(myPath, "\"))
    SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
    On Error GoTo 0

'Determine Base File Name
    If InStr(1, myFileName, VersionExt) > 1 Then
        myArray = Split(myFileName, VersionExt)
        SaveName = myArray(0)
    Else
        SaveName = myFileName
    End If

'Test to see if file name already exists
    If FileExist(FolderPath & SaveName & SaveExt) = False Then
        ActiveWorkbook.SaveAs FolderPath & SaveName & SaveExt
        Exit Sub
    End If

'Need a new version made
    Do While Saved = False
        If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
            ActiveWorkbook.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
            Saved = True
        Else
            x = x + 1
        End If
    Loop

'New version saved
    MsgBox "New file version saved (version " & x & ")"

    Exit Sub

'Error Handler
NotSavedYet:
    MsgBox "This file has not been initially saved. " & _
        "Cannot save a new version!", vbCritical, "Not Saved To Computer"

End Sub

Function FileExist(FilePath As String) As Boolean
    Dim TestStr As String

    'Test File Path (ie "C:\Users\tinker\Desktop\Status_Reports\Version\Metrics_Mar15.xlsm")
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0

'Determine if File exists
    If TestStr = "" Then
        FileExist = False
    Else
        FileExist = True
    End If
End Function