run excel file only on designated computer

[vipulhumein]

i have made an excel file which is private one. so i want that the file won't open in another computer. i want exactly that the file should run only on designated computer something like run only in designated machine id. so that my employee if they copied that file also they cant access on another computer

 

[Hui]

Vipulhumein


Firstly, Welcome to the Chandoo.org Forum


You could use the pc's IP address to do what your after

In a Code Module add:

[pre]

Private Declare Function GetIpAddrTable_API Lib "IpHlpApi" Alias "GetIpAddrTable" (pIPAddrTable As Any, pdwSize As Long, ByVal bOrder As Long) As Long

' Returns an array with the local IP addresses (as strings).
' Author: Christian d'Heureuse, www.source-code.biz
Public Function GetIpAddrTable()
Dim Buf(0 To 511) As Byte
Dim BufSize As Long: BufSize = UBound(Buf) + 1
Dim rc As Long
rc = GetIpAddrTable_API(Buf(0), BufSize, 1)
If rc <> 0 Then Err.Raise vbObjectError, , "GetIpAddrTable failed with return value " & rc
Dim NrOfEntries As Integer: NrOfEntries = Buf(1) * 256 + Buf(0)
If NrOfEntries = 0 Then GetIpAddrTable = Array(): Exit Function
ReDim IpAddrs(0 To NrOfEntries - 1) As String
Dim i As Integer
For i = 0 To NrOfEntries - 1
Dim j As Integer, s As String: s = ""
For j = 0 To 3: s = s & IIf(j > 0, ".", "") & Buf(4 + i * 24 + j): Next
IpAddrs(i) = s
Next
GetIpAddrTable = IpAddrs
End Function
in the This Workbook Module add:

Private Sub Workbook_Open()
Dim IpAddrs
IpAddrs = GetIpAddrTable
'Change the IP Address and File Name to suit
If IpAddrs(1) <> "192.168.50.64" Then Workbooks("BOOK1.XLSM").Close SaveChanges:=False

End Sub

[/pre]

 

[d380013]

is it any other way bcz IP address changed daily

 

[Hui]

You could use the PC's Hard Disk Serial Number


In a Code Module

[pre]

Function GetHDSerial() As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
DiskVolumeId = Format(CDbl(FSO.Drives("C:").SerialNumber))
End Function
in the This Workbook Module add:


Private Sub Workbook_Open()
Dim HDSer As Variant
HDSer = GetHDSerial
'Change the HD Serial Number to suit
If HDSer <> 1249554981 Then Workbooks("BOOK1.XLSM").Close SaveChanges:=False

[/pre]
To get the PC's Hard Disk serial Number copy the above function into a code module

In the Intermediate Window type:

? GetHDSerial

 

[vipulhumein]

HI HUI

AS GIVEN BY YOU TO USE HARD DISK SERIAL NUMBER TO OPEN ON DESIGNATED COMPUTER BUT WHEN I TYPE MY HARD DISK SERIAL I.E WD-WX31A80P3675 SOME COMPILE ERROR COMES IT DOESNT WORK BUT WHEN I TYPE ANYOTHER NUMBER SUCH AS 1234 THEN THE FILE AUTOMATICALLY DISAPPEARS. AS I WANT TO RUN MY FILE ON MY COMPUTER AND MY HARD DISK SERIAL NO. IS WD-WX31A80P3675.


PLEASE SOLVE IT.

 

[NARAYANK991]

Hi Vipul ,


Make a small change in the GetHDSerial function written by Hui :

[pre]

Function GetHDSerial() As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
GetHDSerial = Format(CDbl(FSO.Drives("C:").SerialNumber))
End Function

[/pre]
Copy the above code in a module ( after having inserted it ) ; in the Immediate Window , type in :


?GetHDSerial


and see what number is printed. Put this number in the following statement in the Workbook_Open procedure :


If HDSer <> 1249554981 Then Workbooks("BOOK1.XLSM").Close SaveChanges:=False


instead of the number which has been used there 1249554981.


Narayan

 

[sgmpatnaik]

@Hui / Narayank991


hello sir sorry to ask here


i have small doubt when we use the above mention codes the file is work in only one computer it is great


my doubt is if we share the file in one office then is it work in all computers


Thanks


SP

 

[Hui]

SP

Thats correct

The code above is designed so that the file will only work on one PC or network connection


If you want to use it on more than 1 don't put the code in

or you could modify it to work on say part of the network if the part of the office was all in the same IP address range eg: 192.168.1.1 : 192.168.1.100

 

[sgmpatnaik]

Thank Q Sir


for your replay


Thanks


SP

 

[d380013]

Can any one share a file