7 buttons to open 7 files with 7 subs..... and a partridge i

[VegasNath]

I am about to create 7 (Forms) buttons that will open 7 different files with 7 different sub routines. I can do this OK but it seems a little OTT. Are there any slicker suggestions?

[Reimer]

How about calling up a form with Radio buttons, each assigned to different code?

[HansV]

Or use a list box or combo box to select the file, and a single button that uses a Select Case statement to call a subroutine depending on the user's choice.

Sevenswansaswimming.jpg

[Reimer]

Listen to Hans

[VegasNath]

Thanks both, I'm on it........

[VegasNath]

What is wrong with my syntax here?

Workbooks.Open(Filename:=xxx.xls")

[HansV]

You're missing a quote:

Set wbk = Workbooks.Open(Filename:="xxx.xls")

or

Workbooks.Open Filename:="xxx.xls"

[VegasNath]

Thanks Hans. This is what I have which is nearly finished bar 3 little things:

Code: Select all

Option Explicit

Function FileExists(strFullName As Variant) As Boolean
    FileExists = Not (Dir(strFullName) = "")
End Function

Function FileInUse(strFullName As String) As Boolean
    Dim f As Integer
    On Error Resume Next
    f = FreeFile
    Open strFullName For Input Lock Read As #f
    Close #f
    FileInUse = (Err = 70)
End Function

Function FileAvailable(strFullName As String) As Boolean
    If FileExists(strFullName) Then
        FileAvailable = Not FileInUse(strFullName)
    End If
End Function

Sub FileOpener()

Dim Msg As String, Voice As String, strPath As String, strFile As String, strMnth As String, Password1 As String, Password2 As String, strDateWork As String, strInfo As String
Dim wb As Workbook

strPath = ThisWorkbook.Path & "\"

strMnth = Right(strPath, 3)
strMnth = Left(strMnth, 2)

strDateWork = ThisWorkbook.Sheets("Sheet1").Range("DateWork")

Password1 = "xxx"
Password2 = Password1 & LCase(Format(strDateWork, "mmmm"))

Application.ScreenUpdating = False
    
    Voice = Sheets("Sheet1").Range("R5")
    
    If Voice = 2 Then
        strFile = "1. Month " & strMnth & " 5.8 Consolidated.xls"
    ElseIf Voice = 3 Then
        strFile = "2. Month " & strMnth & " 5.17 Consolidated.xls"
    ElseIf Voice = 4 Then
        strFile = "3. Month " & strMnth & " 5.18 Consolidated.xls"
    ElseIf Voice = 5 Then
        strFile = "4. Month " & strMnth & " 5.19 Consolidated.xls"
    ElseIf Voice = 6 Then
        strFile = "5. Month " & strMnth & " Daily Walk *.xls"
    ElseIf Voice = 7 Then
        strFile = "5a. Month " & strMnth & " Replacement Accounts.xls"
    ElseIf Voice = 8 Then
        strFile = "6. Month " & strMnth & " Calendarisation Impact and Total Performance To Date.xls"
    Else
        ThisWorkbook.Sheets("Sheet1").Range("R5") = 1
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    If FileAvailable(strPath & strFile) = False Then
        strInfo = strInfo & strPath & strFile & vbCrLf & vbCrLf
    End If

    If strInfo <> "" Then
        Msg = vbCrLf & "File Checker"
        Msg = Msg & vbCrLf & vbCrLf & "The following file is not available."
        Msg = Msg & vbCrLf & vbCrLf & strInfo
        Msg = Msg & "This may be due to either ""non-existance"" or ""write access unavailable""."
        Msg = Msg & vbCrLf & vbCrLf & "Process Aborted"
        MsgBox Msg, vbCritical, "File Checker"
        strInfo = ""
        ThisWorkbook.Sheets("Sheet1").Range("R5") = 1
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Exit Sub
    Else
        Set wb = Workbooks.Open(Filename:=strPath & strFile)
    End If
    
    ThisWorkbook.Sheets("Sheet1").Range("R5") = 1
    
Application.ScreenUpdating = True

End Sub

1. File 5...... needs to be checked and opened using the DIR thingy, how can I do that here? - SOLVED by combining strPath & strFile as strFile, wrapping file 5 in Dir(.....)
2. File 5...... requires passwords 1 and 2 to open
3. File 6...... requires password 1 to open

Any other comments or criticisms gratefully received. TIA.

[HansV]

What a mess! I hope that this does what you want.

Code: Select all

Function FileExists(strFullName As Variant) As Boolean
    FileExists = Not (Dir(strFullName) = "")
End Function

Function FileInUse(strFullName As String) As Boolean
    Dim f As Integer
    On Error Resume Next
    f = FreeFile
    Open strFullName For Input Lock Read As #f
    Close #f
    FileInUse = (Err = 70)
End Function

Function FileAvailable(strFullName As String) As Boolean
    If FileExists(strFullName) Then
        FileAvailable = Not FileInUse(strFullName)
    End If
End Function

Sub FileOpener()
    Dim Msg As String, Voice As String, strPath As String, strFile As String, strMnth As String
    Dim Password1 As String, Password2 As String, strDateWork As String, strInfo As String
    Dim wb As Workbook

    strPath = ThisWorkbook.Path & "\"

    strMnth = Right(strPath, 3)
    strMnth = Left(strMnth, 2)

    strDateWork = ThisWorkbook.Sheets("Sheet1").Range("DateWork")

    Password1 = "xxx"
    Password2 = Password1 & LCase(Format(strDateWork, "mmmm"))

    Application.ScreenUpdating = False

    Voice = Sheets("Sheet1").Range("R5")

    If Voice = 2 Then
        strFile = "1. Month " & strMnth & " 5.8 Consolidated.xls"
    ElseIf Voice = 3 Then
        strFile = "2. Month " & strMnth & " 5.17 Consolidated.xls"
    ElseIf Voice = 4 Then
        strFile = "3. Month " & strMnth & " 5.18 Consolidated.xls"
    ElseIf Voice = 5 Then
        strFile = "4. Month " & strMnth & " 5.19 Consolidated.xls"
    ElseIf Voice = 6 Then
        strFile = Dir(strPath & "5. Month " & strMnth & " Daily Walk *.xls")
    ElseIf Voice = 7 Then
        strFile = "5a. Month " & strMnth & " Replacement Accounts.xls"
    ElseIf Voice = 8 Then
        strFile = "6. Month " & strMnth & " Calendarisation Impact and Total Performance To Date.xls"
    Else
        ThisWorkbook.Sheets("Sheet1").Range("R5") = 1
        Application.ScreenUpdating = True
        Exit Sub
    End If

    If FileAvailable(strPath & strFile) = False Then
        strInfo = strInfo & strPath & strFile & vbCrLf & vbCrLf
    End If

    If strInfo <> "" Then
        Msg = vbCrLf & "File Checker"
        Msg = Msg & vbCrLf & vbCrLf & "The following file is not available."
        Msg = Msg & vbCrLf & vbCrLf & strInfo
        Msg = Msg & "This may be due to either ""non-existance"" or ""write access unavailable""."
        Msg = Msg & vbCrLf & vbCrLf & "Process Aborted"
        MsgBox Msg, vbCritical, "File Checker"
        strInfo = ""
        ThisWorkbook.Sheets("Sheet1").Range("R5") = 1
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Exit Sub
    Else
        Select Case Voice
            Case 5
                Set wb = Workbooks.Open(Filename:=strPath & strFile, _
                    Password:=Password1, WriteResPassword:=Password2)
            Case 6
                Set wb = Workbooks.Open(Filename:=strPath & strFile, _
                    Password:=Password1)
            Case Else
                Set wb = Workbooks.Open(Filename:=strPath & strFile)
        End Select
    End If

    ThisWorkbook.Sheets("Sheet1").Range("R5") = 1

    Application.ScreenUpdating = True
End Sub

[Reimer]

Like I said, listen to Hans
LOL

[VegasNath]

What a mess! I hope that this does what you want.

That's a bit harsh. Mostly yes, Thanks! Here's the working version.

Code: Select all

Option Explicit

Function FileExists(strFullName As Variant) As Boolean
    FileExists = Not (Dir(strFullName) = "")
End Function

Function FileInUse(strFullName As String) As Boolean
    Dim f As Integer
    On Error Resume Next
    f = FreeFile
    Open strFullName For Input Lock Read As #f
    Close #f
    FileInUse = (Err = 70)
End Function

Function FileAvailable(strFullName As String) As Boolean
    If FileExists(strFullName) Then
        FileAvailable = Not FileInUse(strFullName)
    End If
End Function

Sub A02_FileOpener()
    Dim Msg As String, Voice As String, strPath As String, strFile As String, strMnth As String
    Dim Password1 As String, Password2 As String, strDateWork As String, strInfo As String
    Dim wb As Workbook

    strPath = ThisWorkbook.Path & "\"

    strMnth = Right(strPath, 3)
    strMnth = Left(strMnth, 2)

    strDateWork = ThisWorkbook.Sheets("Sheet1").Range("DateWork")

    Password1 = "xxx"
    Password2 = Password1 & LCase(Format(strDateWork, "mmmm"))

    Application.ScreenUpdating = False

    Voice = Sheets("Sheet1").Range("R5")

    If Voice = 2 Then
        strFile = "1. Month " & strMnth & " 5.8 Consolidated.xls"
    ElseIf Voice = 3 Then
        strFile = "2. Month " & strMnth & " 5.17 Consolidated.xls"
    ElseIf Voice = 4 Then
        strFile = "3. Month " & strMnth & " 5.18 Consolidated.xls"
    ElseIf Voice = 5 Then
        strFile = "4. Month " & strMnth & " 5.19 Consolidated.xls"
    ElseIf Voice = 6 Then
        strFile = Dir(strPath & "5. Month " & strMnth & " Daily Walk *.xls")
    ElseIf Voice = 7 Then
        strFile = "5a. Month " & strMnth & " Replacement Accounts.xls"
    ElseIf Voice = 8 Then
        strFile = "6. Month " & strMnth & " Calendarisation Impact and Total Performance To Date.xls"
    Else
        ThisWorkbook.Sheets("Sheet1").Range("R5") = 1
        Application.ScreenUpdating = True
        Exit Sub
    End If

    If FileAvailable(strPath & strFile) = False Then
        strInfo = strInfo & strPath & strFile & vbCrLf & vbCrLf
    End If

    If strInfo <> "" Then
        Msg = vbCrLf & "File Checker"
        Msg = Msg & vbCrLf & vbCrLf & "The following file is not available."
        Msg = Msg & vbCrLf & vbCrLf & strInfo
        Msg = Msg & "This may be due to either ""non-existance"" or ""write access unavailable""."
        Msg = Msg & vbCrLf & vbCrLf & "Process Aborted"
        MsgBox Msg, vbCritical, "File Checker"
        strInfo = ""
        ThisWorkbook.Sheets("Sheet1").Range("R5") = 1
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Exit Sub
    Else
        Select Case Voice
            Case 6
                Set wb = Workbooks.Open(Filename:=strPath & strFile, _
                    Password:=Password1, WriteResPassword:=Password2)
            Case 8
                Set wb = Workbooks.Open(Filename:=strPath & strFile, _
                    WriteResPassword:=Password1)
            Case Else
                Set wb = Workbooks.Open(Filename:=strPath & strFile)
        End Select
    End If

    ThisWorkbook.Sheets("Sheet1").Range("R5") = 1

    Application.ScreenUpdating = True
End Sub

Thanks for all the help.

[HansV]

With "What a mess" I didn't mean to criticize your code, but that it is a rather complicated setup. Sorry if I offended you.

[VegasNath]

With "What a mess" I didn't mean to criticize your code, but that it is a rather complicated setup. Sorry if I offended you.

no worries, I gave myself 7 slaps for over complicating things.

I have just noticed a problem though. The "5....." file with the wildcard:
Opens as expected.
Provides the expected message if the file is unavailable (already in use)
But, I get a RTE 1004 error if there is no file in the expected location.

Any idea how to get around that and provide the expected msgbox?

[HansV]

In the line

Code: Select all

        strFile = Dir(strPath & "5. Month " & strMnth & " Daily Walk *.xls")

strFile will be an empty string if there is no file matching the pattern. So you could add code like this immediately below it:

Code: Select all

        If strFile = "" Then
            MsgBox "There is no such file!", vbCritical
            Exit Sub
        End If

[VegasNath]