Solved: Only running MyExcel.xls on named machine?

[Simon Lloyd]

Hi all, every users machine has a unique name, is it possible in VBA to only allow your program to run on a machine with a specific name?. I have a program which we use here at work and its on a network drive but some people are taking a copy home working on it and then copying it back to the network, however if people have made changes to it in the meantime they get wiped out when the unscrupulous person who took a copy home writes back to the network.

What i would like to do is send everyone who has access to the program an excel file which when opened collects the machine name, they can then mail it back to me where i could then try to incorporate it in my VBA to only allow machines in the list.

Is it possible?

Regards,
Simon

[mvidas]

Hi Simon,

The snippet[vba]environ("computername")[/vba]Will return the computer's name. You could put something like this at the top of your vba:[vba]if environ("computername") <> "VBAXPC" then exit sub[/vba]
To collect the computer names like you described (assuming you have outlook on each machine):[vba]Sub SendComputerName()
Dim olApp As Object
Set olApp = CreateObject("outlook.application")
With olApp.CreateItem(0)
.To = "slloyd@abc.com"
.Subject = "My computer name"
.Body = Environ("computername")
.Send
End With
Set olApp = Nothing
End Sub[/vba]Though there should be some administrator tools to get all those names without having to deal with enabling macros, outlook security warnings, etc. However, I don't know them.

Matt

[CCkfm2000]

thanks mvidas

just used some of the above code on my spreadsheet.

works well for what i need.

[Ken Puls]

Hey guys,

While what you're trying to do will work, you're going to have to maintain it, which can be kind of a pain. Also, what happens when you move on, and a new user needs to be added?

The route I go with this, which involves a lot less headache, is to check for the existence of Drive H:\ on my system. Most users do not have more than a C,D or E drive at home, so this works for me. To go one step further, you could find a specific drive that everyone has access to, and drop a file in there. If the file doesn't exist, then don't let them write.

The beauty is that as long as the mapped drive doesn't change (something most IT departments try to avoid), you should be okay. Just make sure you pick one that everyone has access to, and is high enough that most users won't have it at home. If you can't, then go the file route.

I use this function to check for either files or directories, as it works with both.

HTH,

[Simon Lloyd]

MVidas, thanks for the detailed reply, not all machines have Outlook (as some are laptops!) is there a way Excel can collect the machine name?

Ken i understood what you are getting at, the network drive that the workbook is stored on is E:, none of our machines here have CD Rom or floppy drives (so we cant load any software!) but we do have USB's for using our companies data keys (data keys issued by the company dont work at home and vice versa), the problem of specifying a drive is that when managers or upper level staff connect their laptops the drive letter to them is no longer E: as they are fitted with all usual peripherals.

Regards,
Simon

[Ken Puls]

Hi Simon,

Okay, how about this then... drop another file in the same directory as the workbook on your network. Just don't tell anyone about it.

You can then check for the file using:
[vba]If FileOrFolderExists(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
End If[/vba]

If you felt really tricky, you could check if the file was in the directory that it is supposed to be in, or even create a file in a directory that is... say...

E:\Excel Files\TheReport.xls
E:\Confidential\MyKey.txt

By using Thisworkbook.Path, you are looking at the path where the workbook is stored. So long as you come up with something the users don't know they need to replicate, you should be fine.

[Simon Lloyd]

Ken.....amazingly fast response!, as you will be aware we are networked and as such only have access to certain folders on certain drives, the workbook is stored in E:\Analyst\PublicFile\Raw, on this drive this is the only path i have access to as my work deals with manipulating the raw figures that users deposit, can i still use your suggestion here?, the user would be able to copy the folder with the .txt file in it.

Regards,
Simon

[Simon Lloyd]

I can create a text file like this: [VBA]Sub TextFileCreate()

Close #1
Open Application.Text(Now(), "dd mm yyyy") & ".TXT" For Output As #1

Close #1

End Sub[/VBA] i would just need to add the path to save it to, but i fear i can only save it to the path the folder is in on that drive!

Regards,
Simon

[mvidas]

Simon,

As for getting a list of computer names, it is possible, but depending on the size of your company it could be a HUGE list (when I just ran it I got 4874 names)
But to get it:[vba]Sub GetComputerNames()
Dim vFF As Long, cNames() As String, Cnt As Long, tStr As String
Shell "Net view >c:\compNames.txt"
vFF = FreeFile
Open "C:\compnames.txt" For Input As #vFF
Do Until EOF(vFF)
Line Input #vFF, tStr
If Left(tStr, 2) = "\\" Then
ReDim Preserve cNames(Cnt)
cNames(Cnt) = Mid(tStr, 3, InStr(tStr, " ") - 2)
Cnt = Cnt + 1
End If
Loop
Close #vFF

'cNames now holds an array of all the computer names on the network

'for display purposes
Range("A1").Resize(Cnt, 1).Value = Application.Transpose(cNames)
End Sub[/vba]Matt

[Ken Puls]

Matt, nice!

Simon, the setup you have is still workable for my suggestion as long as everyone is accessing that file from the same drive. The problem you're going to deal with is that some people are going to have an old copy floating around out there.

No need to create this by code, just make a plain old text file called "auth.txt". Drop it in the same directory as your workbook.

Go into your workbook and put this in the ThisWorkbook module:

[vba]Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If FileOrFolderExists(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[/vba]
If you want to test it, rename the auth.txt file to something else, open the workbook, put some data in, and try to save it.

PS, don't forget that you'll also need to copy in the routine that I linked to on my website earlier in the thread.

HTH,

[Charlize]

Functions to retrieve username and computername. Two subs to demonstrate. Instead of a msgbox you could write the info to a sheet thats hidden so the people don't know why you want this. Everyone must open the sheet once (via workbook open you could automate the collecting of your requested info). After a week you take the spreadsheet from the network drives and hopefully everyone has granted your wishes. ---Thinking : is it possible to send an automated message to you. I know there exists something as a send command through cmd-window. Maybe by shell-command ---
[VBA]Option Explicit
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
Private Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
Public Function NameOfComputer()
' Returns the name of the computer
Dim ComputerName As String
Dim ComputerNameLen As Long
Dim Result As Long
ComputerNameLen = 256
ComputerName = Space(ComputerNameLen)
Result = GetComputerName(ComputerName, ComputerNameLen)
If Result <> 0 Then
NameOfComputer = Left(ComputerName, ComputerNameLen)
Else
NameOfComputer = "Unknown"
End If
End Function
Function UserName() As String
' Returns the name of the logged-in user
Dim Buffer As String * 100
Dim BuffLen As Long
BuffLen = 100
GetUserName Buffer, BuffLen
UserName = Left(Buffer, BuffLen - 1)
End Function
Sub show_computername()
Dim pc_name As String
pc_name = UCase(NameOfComputer)
MsgBox ("This computer his name : " & pc_name)
End Sub
Sub show_username()
Dim inlogname As String
inlogname = UCase(UserName)
MsgBox ("Inlogname user : " & inlogname)
End Sub[/VBA]
Charlize

[mvidas]

Good point, Charlize! Might get a little annoying at times for Simon though
[vba]Sub SendPCName()
Shell "Net send slloyd " & Environ("computername")
End Sub[/vba] Replace your network username with slloyd

[Simon Lloyd]

Guys!........fantastic responses as ever, i have now added the code to my workbook that charlize gave (i have test driven the other code suggestions), however i like the idea of colleccting the names on a worksheet, MVIDAS the SendPCName sub you gave how do i use that? my networkname is "vrtSzL04" so would i substitute slloyd for that?

Regards,
Simon

[mvidas]

Yep
You can test it yourself if you wanted, go to start, then run, and in the run dialog enter
net send vrtSzL04 hi

You should see what it looks like there
Matt

[Simon Lloyd]

Matt, Charlize and Ken, I know ive marked this thread solved but just wanted to give feedback. Matt your code for collecting machine names gave an error first until i created compNames.txt in C: but then when run did not populate the .txt file or excel and i dont pretend to understand how you are polling the machines, Charlize your functions do what i would like only everytime a user logs on it records the information again, after 2 days i have multiple entries from 23 people, Ken your code is great for keeping the work locked down to only being edited on the network (as was my original problem) but collecting the names gives me greater control over who accesses the file i.e joe bloggs cant give Fred bloggs his login to access the file unless its on the same machine.

The "Net Send" command is kinda cool but is there a way of capturing the required data off it or do i have to go through cancelling 172 (yes i counted 'em) net messages again?

Still great and thorough responses.....as ever!, i'm at present trying to incorporate Kens code along with capturing Username and Machine name but still at present getting multiple hits of the same name.

Once again thanks guys!

Regards,
Simon

[mvidas]

Matt your code for collecting machine names gave an error first until i created compNames.txt in C: but then when run did not populate the .txt file or excel and i dont pretend to understand how you are polling the machines

The file should be created using the line[vba]Shell "Net view >c:\compNames.txt"[/vba]The 'shell' part of that more or less tells excel to run that on a command line.. the "Net view" is a command to see the network (like 'net send' is used to send a message in the network), and the ">" tells excel to send the results to that file.
Do me a favor, go to Start, then Run, and once your dos window is open just type "net view" and press enter. I'm curious to see what comes up for you.

The "Net Send" command is kinda cool but is there a way of capturing the required data off it or do i have to go through cancelling 172 (yes i counted 'em) net messages again?

There is no way of capturing that message window (not an easy way), but what you just said begs the question:
Do you really want 172 computer names hard coded into your code? Seems to me it would be easier to use Ken's method.
But as I like to give different examples, are you on an exchange server and do you know your SMTP server name?
If you think you are on exchange (many companies are) but don't know the server, and go to Tools / Services, on the services tab there should be a listbox with one option of "Microsoft Exchange Server". Click that, and go to Properties. Write down the server listed there, and you could try using CDO to send a message (if its installed on the machine):[vba]Sub SendSimonComputerName()
Dim objCDO As Object
On Error Resume Next
Set objCDO = CreateObject("CDO.Message")
On Error GoTo 0
If objCDO Is Nothing Then 'cdo must not be installed on the machine
Exit Sub
End If
With objCDO
.Subject = "Computer name"
.From = "ComputerNames@domain.com"
.To = "simon.lloyd@company.com"
.TextBody = "Username: " & Environ("username") & vbCrLf & _
"Computer name: " & Environ("computername")
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/con...tion/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/con...ion/smtpserver") = SmtpServer
.Item("http://schemas.microsoft.com/cdo/con...smtpserverport") = 25
.Update
End With
.Send
End With
Set objCDO = Nothing
End Sub[/vba]Replace your real email address into the .To line, and replace "SmtpServer" with your server.

In the end, I'd say if you still want to hardcode the computer names, then try using the 'net view' again. If it doesn't work, consider Ken's method The above is just a workaround, you'd still have to gather the data from each email you received.

[Ken Puls]

Another though, instead of the email...

Create a database in the same directory as the excel file. Add the message to check if the database is there. If it isn't, they get the message that they are working away from the office.

Add some code to write the values you want to the database. (I have code examples of doing this kind of thing with Access.) If the database is there, write the user's login ID and computer name to the database.

After a certain amount of time, you cut out the routine that adds credentials, and start to check the computer name and login ID against what you've logged in the database to see if they should get access. If the username is there, but the computer name doesn't match, you can tell them to go back to their desk. If the computer name is a match, but the username isn't, you can tell them that they are not authorized.

The nice thing about this route is that you don't have to deal with 172 separate users once you write the code. You let them start adding themselves for a while.

Once you cut off the add functionality, though, you could also add a routine that, if access is denied, offers to email you their credentials for inclusion. (via net send or whatever.)

Just a thought.

[Simon Lloyd]

Matt, i dont have the Cmd facility on my machine (admin only) and i have no idea how our servers are set up, i did try sending "Net view" to my machines desktop but to no avail, nice suggestion with the cdo but there is that problem of manually inputting the captured data into a file.

Ken, your suggestion sounds great, thats the mix of the both things i wanted....only able to use the workbook in its network location, and only the users specified at the specified machines, is this how i would do that?

Sub CollectNames()
Dim CN, UN
Dim nRow, nRow1 As Long
nRow = Sheets("Sheet1").Range("A65336").End(xlUp).Row + 1
nRow1 = Sheets("Sheet1").Range("B65336").End(xlUp).Row + 1
Set CN = Environ("ComputerName")
Set UN = Environ("UserName")
Workbooks.Open ("C:\Documents and Settings\vrtSzL04\Desktop\Names Test.xls")
nRow = UN
nRow1 = CN
Workbook.Save
Workbooks("C:\Documents and Settings\vrtSzL04\Desktop\Names Test.xls").Close
End Sub

i get a type mismatch error with Set Cn...etc could you explain why?. As i have said previously im still learning along the way and sometimes its a little difficult to decipher what you guys put together...but as ever i'm trying!

"Very" my mum says!

Regards,
Simon

[Ken Puls]

Hi Simon,

Your code is close. CN and UN are both variant strings in your case, and you're trying to set them as objects. If you want to run your code, you'd dim them as strings and just assign the values with them. No set statements:

[vba]Sub CollectNames()
Dim CN As String, UN As String
Dim nRow As Long, nRow1 As Long
nRow = Sheets("Sheet1").Range("A65336").End(xlUp).Row + 1
nRow1 = Sheets("Sheet1").Range("B65336").End(xlUp).Row + 1
CN = Environ("ComputerName")
UN = Environ("UserName")
Workbooks.Open ("C:\Documents and Settings\vrtSzL04\Desktop\Names Test.xls")
Workbooks("Names Test.xls").Worksheets("Sheet1").Range("A" & nRow) = UN
Workbooks("Names Test.xls").Worksheets("Sheet1").Range("A" & nRow1) = CN
Workbook.Save
Workbooks("C:\Documents and Settings\vrtSzL04\Desktop\Names Test.xls").Close
End Sub[/vba]

I didn't test the above, but it shoudl work. Personally, though I'd go with something like this. Same functionality, but looks a little more elegant.

[vba]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[/vba]

HTH,

[Simon Lloyd]

Thanks Ken, very neat and a lot easier to read than mine!, i have put the code in to a workbook on the network that users dump raw data into, the beauty of this is only the real users would use this (so i can capture them), my analytical workbook is the one i want to protect to only use on the network and only by people on a list, what i intend to do is put all the names captured on a worksheet in the analytical workbook so that the code will Vlookup or something like that the name of the user and either allow or deny working access to the workbook. Did that make sense? i currently have your code for checking for authr.txt in the workbook but it is in the workbook folder, if i use thisworkbook.path and the user copies the folder for use at home will it defeat the security your code adds ? i.e ThisWorkBook.Path would then be C:\.

Thanks for your continued support i this Ken, i do understand that it is probably getting annoying for you now, because i know i get annoyed at work at people who dont "get" what i see as simple!

Regards,
Simon