Function Property(aaa) 'Excel Maintains: Title, Subject, Author, Keywords, Comments, ' Last Author, Application Name, Last Print Date, Creation Date, ' Last Save Time, ' Security, Category, Manager, Company 'Some DejaNews threads: AN=393501043, AN=371066133 'also see Chip Pearson's http://www.cpearson.com/excel/docprop.htm Property = ActiveWorkbook.BuiltinDocumentProperties(aaa) End Function Sub MarkProperties() rw = 1 'XL95 maintains 13 of the 28 properties listed For Each p In ActiveWorkbook.BuiltinDocumentProperties Cells(rw, 1) = p.Name 'Property() is a user function Cells(rw, 2).Formula = "=property(""" & p.Name & """)" rw = rw + 1 Next End Sub
Worksheets("SheetName").Protect Userinterfaceonly:=True will enable you to programatically write to a worksheet sheet but won't allow manual editing by a user. ---
The following was posted by Norman Harker, 2001-09-25Sub LISTENVIRON() Dim new_value As String Dim txt As String Dim i As Long i = 1 Do new_value = Environ$(i) If Len(new_value) = 0 Then Exit Do txt = txt & new_value & vbCrLf i = i + 1 Loop txt = txt & "UserName = " & Application.UserName & vbCrLf txt = txt & "Active Printer = " & Application.ActivePrinter & vbCrLf txt = txt & "Default Path = " & Application.DefaultFilePath & vbCrLf txt = txt & "Library Path = " & Application.LibraryPath & vbCrLf txt = txt & "Operating System = " & Application.OperatingSystem _ & vbCrLf txt = txt & "Organisation Name = " & Application.OrganizationName & _ vbCrLf txt = txt & "Start Up Path = " & Application.StartupPath & vbCrLf txt = txt & "Excel Version = " & Application.Version & vbCrLf ' val(application.Version) -- 11 = XL 2003, 10 = XP, 9 = 2000, 8 = 97 txt = txt & "Current Workbook Path = " & _ Application.ActiveWorkbook.Path & vbCrLf txt = txt & "Active Woorkbook Name = " & _ Application.ActiveWorkbook.Name MsgBox txt End Sub
Microsoft Excel TMP=C:\WINDOWS\TEMP TEMP=C:\WINDOWS\TEMP PROMPT=$p$g winbootdir=C:\WINDOWS COMSPEC=C:\WINDOWS\COMMAND.COM PATH=C:\Program Files\Microsoft Office\Office\;C:\WINDOWS; C:\WINDOWS\COMMAND;C:\BK1\D\SPFPC40;C:\BK1\D\GOODIES CLASSPATH=C:\PROGRA~1\CANONC~1\PHOTOD~1\ADOBEC~1 CMDLINE=WIN windir=C:\WINDOWS BLASTER=A220 I5 D1 T4 UserName = David McRitchie Active Printer = Panasonic KX-P5400 v2013.112 on LPT1: Default Path = Library Path = C:\PROGRAM FILES\MICROSOFT OFFICE\OFFICE\LIBRARY Operating System = Windows (32-bit) 4.10 Organisation Name = Start Up Path = C:\WINDOWS\Application Data\Microsoft\Excel\XLSTART Excel Version = 9.0 Current Workbook Path = C:\temp Active Woorkbook Name = martin_hyperlinks.xls
OK The following was posted by Gary Brown, in same thread, and which he indicated was borrrowed HEAVILY from John Walkenbach's "Microsoft Excel 2000 Power Programming with VBA" (Strongly recommended!) -
'/======================================/ Declare Function GetWindowsDirectoryA Lib "kernel32" _ (ByVal lpbuffer As String, ByVal nsize As Long) As Long '/======================================/ Sub OpSysPath() Dim strPath As String, strDir As String strPath = Space(255) strDir = Left(strPath, _ GetWindowsDirectoryA(strPath, Len(strPath))) MsgBox strDir End Sub '/======================================/Result for me: C:\WINDOWS
See the above Environ("Username") Environ("Computername")
Function USRNameF() USRNameF = Application.UserName End Function =USRNameF()
Then in any cell just enter =UserName (without parens). Jim Rech 2001-07-27 programming
Just a slight caution: If you use this method, just don't copy the cell with that formula to another sheet. In Excel 97, this will cause a general protection fault and Excel will be closed (losing any unsaved work). Newer versions may be more robust, but I haven't tested with them. As long as you are cognizant of this, it shouldn't cause problems. Tom Ogilvy
Option Compare Database Option Explicit Private Declare Function apiGetUserName Lib "advapi32.dll" _ Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Function fOSUserName() As String ' Returns the network login name Dim lngLen As Long, lngX As Long Dim strUserName As String strUserName = String$(254, 0) lngLen = 255 lngX = apiGetUserName(strUserName, lngLen) If lngX <> 0 Then fOSUserName = Left$(strUserName, lngLen - 1) Else fOSUserName = "" End If End FunctionFormerly had cited a simpler one by Chris Rae http://www.chrisrae.com/vba/routines/getusername.html but it was pointed out by Harlan Grove that it did not check the buffersize.
Visit [my Excel home page] [Index page] [Excel Onsite Search] [top of this page]
Please send your comments concerning this web page to: David McRitchie send email comments
Copyright © 1997 - 2004, F. David McRitchie, All Rights Reserved