ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Accessing the Desktop (https://www.excelbanter.com/excel-programming/271658-re-accessing-desktop.html)

Orlando Magalhães Filho

Accessing the Desktop
 
Hi Brent McIntyre

Try get from register. Put this code on standard module and run the test.

Public Const vStr As Long = 255
Public Const REG_BINARY = 3&
Public Const REG_DWORD = 4&
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA"
_
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByRef lpType As Long, _
ByVal lpData As String, _
ByRef lpcbData As Long) As Long ' Note that if you declare the lpData
_
'parameter as String, you must pass
it By Value.
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002


'Get Registry Value, Arguments:
'1 - Reg Key (Ex.: HKEY_LOCAL_MACHINE),
'2 - Reg SubKey (Ex.: "Software\Microsoft\Windows\CurrentVersion"),
'3 - Name of Value (Ex.:"ProgramFilesDir" or "" for default)
Function GetRegValue(Key As Long, SubKey As String, ValueName As String) As
String
Dim RetStr As String * vStr 'Fixed-length strings
Dim fctRet As Long
Dim OpenKeyHdl As Long
Dim vType As Long
Dim vLen As Long
Dim i As Integer

GetRegValue = "Error"
vLen = vStr
fctRet = RegOpenKey(Key, SubKey, OpenKeyHdl)
If fctRet < 0 Then Exit Function

fctRet = RegQueryValueEx(OpenKeyHdl, ValueName, 0&, vType, RetStr, vLen)
RegCloseKey OpenKeyHdl
If fctRet < 0 Then Exit Function

If vType = REG_BINARY Then
GetRegValue = ""
For i = 1 To vLen
GetRegValue = GetRegValue _
& IIf(Len(Hex(Asc(Mid(RetStr, i, 1)))) = 1, "0", "") _
& Hex(Asc(Mid(RetStr, i, 1))) & " "
Next
Exit Function
End If

If vType = REG_DWORD Then
GetRegValue = "0x"
For i = 4 To 1 Step -1
GetRegValue = GetRegValue _
& IIf(Len(Hex(Asc(Mid(RetStr, i, 1)))) = 1, "0", "") _
& Hex(Asc(Mid(RetStr, i, 1)))
Next
Exit Function
End If

GetRegValue = Left(RetStr, vLen - 1)
End Function

Private Sub TestGet()
'Test 1 Standard folders
MsgBox GetRegValue(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Explore r\Shell Folders",
"Desktop")
MsgBox GetRegValue(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Explore r\Shell Folders",
"Programs")
MsgBox GetRegValue(HKEY_LOCAL_MACHINE,
"Software\Microsoft\Windows\CurrentVersion", "ProgramFilesDir")
MsgBox GetRegValue(HKEY_LOCAL_MACHINE,
"Software\Microsoft\Windows\CurrentVersion", "ProgramFilesPath")
'Test 2 Outlook Journal
MsgBox GetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Shared
Tools\Outlook\Journaling\Microsoft Excel", "Enabled")
'Test 3 Calendar
MsgBox GetRegValue(HKEY_CLASSES_ROOT, "MSCAL.Calendar", "")
'Test 4 Screen resolution
MsgBox
Application.WorksheetFunction.Clean(GetRegValue(HK EY_LOCAL_MACHINE,
"Config\0001\Display\Settings", "Resolution"))
End Sub


HTH

---
Orlando Magalhães Filho

(So that you get best and rapid solution and all may benefit from the
discussion, please reply within the newsgroup, not in email)

"Brent McIntyre" escreveu na mensagem
...
Good afternoon all,

Does anyone know how to access the desktop on a Windows
XP machine ? I need to write a text file there but don't
want to input the username, as in XP the Desktop folder
is created in C:\Documents and Settings\USERNAME\Desktop,
I just want to write the file to ActiveDesktop or similar
and have it done.

Any help would be much appreciated, sorry that my request
isn't to clear.

Yours sincerely,

Brent McIntyre




Brent McIntyre

Accessing the Desktop
 
Orlando,

Thanks very much for your help, although I didn't use your sample in
this project I will be using it in the future, your help has been much
appreciated.

Yours sincerely,

Brent McIntyre

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!


All times are GMT +1. The time now is 09:29 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com