Solved: Only running MyExcel.xls on named machine?

[Simon Lloyd]

Here's all the code i have at the moment (sorry for the length!)

 
Public Sub TestFolderExistence()
    ' Author : Ken Puls (www.excelguru.ca)
    ' Macro Purpose: Test if directory exists
    If FileFolderExists("C:\Documents and Settings\vrtSzL04\Desktop\Test", "fldr") Then
        MsgBox "Folder exists!"
    Else
       MsgBox "Folder does not exist!"
    End If
End Sub
 
Public Sub TestFileExistence()
    ' Author : Ken Puls (www.excelguru.ca)
    ' Macro Purpose: Test if directory exists
    If FileFolderExists("C:\Documents and Settings\vrtSzL04\Desktop\Test\Names Test.xls", "xls") Then
        MsgBox "File exists!"
        ' the file exists, so it is on the company drive
    Else
        MsgBox "You Can Not Work On This File Away From Work, No Changes Will Be Saved!"
        ' the file does not exist, so they must be working remotely
    End If
    Save = False
    Application.Quit
End Sub
 
Sub CollectNames()
    Dim wbDB As Workbook
    Set wbDB = Workbooks.Open("C:\Documents and Settings\vrtSzL04\Desktop\Names Test.xls")
    With wbDB
        With .Worksheets("Sheet1")
            With .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
                .Value = Environ("ComputerName")
                .Offset(0, 1).Value = Environ("Username")
            End With
        End With
        .Close savechanges:=True
    End With
End Sub

This is the thisworkbook module

 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If FileFolderExists(ThisWorkbook.Path & Application.PathSeparator & "auth.txt", "txt") Then
        ' The file exists, so it is on the company drive
    Else
        ' The file does not exist, so they must be working remotely
        MsgBox "Sorry, but you are working away from the office. " & vbNewLine & _
        "To prevent loss of other users work, this workbook" & vbNewLine & _
        "has been restricted for use only while attached" & vbNewLine & _
        "to our corporate network.", vbCritical + vbOKOnly, "Remote Access Error"
        Cancel = True
        Saved = True
    End If
End Sub
 
Private Sub Workbook_Open()
    Dim MyCell
    Dim Rng As Range
    Application.ScreenUpdating = False
    Workbooks.Open (ThisWorkbook.Path & "\" & "Name File.xls")
    Set Rng = Sheets("Sheet1").Range("A1:B300")
    For Each MyCell In Rng
        If MyCell.Value = CN And MyCell.Offset(0, 1) = UN Then
            Exit Sub
        Else
            Call CollectNames
        End If
    Next
    ActiveWorkbook.Close ("Name File.xls")
    Application.ScreenUpdating = True
End Sub

Regards,
Simon