Author Topic: Writing to The REgistry with VBA???  (Read 3655 times)

0 Members and 1 Guest are viewing this topic.

ML

  • Guest
Writing to The REgistry with VBA???
« on: June 12, 2007, 06:29:50 PM »
I am trying to write a path to the registry via VBA.
This code works just fine in a VBScript but I would like to incorporate it into my VBA Module (if possible)
If anyone knows how to make the below code work in VBA, I would really appreciate it.
Or, if the is an alternative method to writing a support path to the registry (via VBA), I would really like to know the method

Thank you

Mark

Code: [Select]
Sub SheetSetTemplatePath_NOT_WORKING()

Dim WshShell, WshNetwork As Object
Dim curver, locale, cprofile
Dim vname  '= Value Name
Dim vdata  '= Value Data

Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")

vname = "SheetSetTemplatePath"


'This reads the currently installed and last accesed version of AutoCAD
curver = WshShell.RegRead("HKCU\Software\Autodesk\AutoCAD\curver")
'There is an additional value under that registry key, it is unique and must be grabbed from here, or else you won't know the location of the profile
locale = WshShell.RegRead("HKCU\Software\Autodesk\AutoCAD\" & curver & "\curver")
'This Key holds only the current profile
cprofile = WshShell.RegRead("HKCU\Software\Autodesk\AutoCAD\" & curver & "\" & locale & "\Profiles\")


'New Path Goes Here
vdata = "I:\Path\Template"


'Write The VName and VData (Support Path)
WshShell.RegWrite "HKCU\Software\Autodesk\AutoCAD\" & curver & "\" & locale & "\Profiles\" & _
cprofile & "\General\" & vname, vdata

'Return the results:
'MsgBox "The Path for " & vname & vbCrLf & vdata & vbCrLf & "has been written to" & vbCrLf & _
'"AutoCAD - " & curver & "," & vbCrLf & "Profile - " & cprofile


End Sub

Dnereb

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #1 on: June 13, 2007, 03:41:41 AM »
Or, if the is an alternative method to writing a support path to the registry (via VBA), I would really like to know the method

Thank you

Mark

Sure,
with Api calls....
this is the class I use, it's a bit complicated at first glance, and the coding and decoding won't work.
I've got the habit of encoding privacy sensitive data and serialnumbers in the registry. for obvious reasons I won't publish that part on the web  :wink:

ML

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #2 on: June 13, 2007, 12:48:02 PM »

Yes, I can understand that Dn.
Just as some things are better un said, some things are best un posted :)

I will look at he file you posted.

Hopefully it is not too complex; these dam allergies have my head spinning today  :-(

Thank you sir

Mark


Dnereb

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #3 on: June 13, 2007, 04:07:43 PM »
I'm no Sir!

Jackasses are evolutionary one step above me... LOL
and I will hail any "wonder llama" i know(insider joke).

If you can't figure it out just ask. and if you don't want to google for "VB registry API" to find other examples.
the class I've posted is based on a example made by Keith or Kerry at Cadvault... if mymemory doesnt play tricks with me.

ML

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #4 on: June 13, 2007, 04:15:53 PM »

Hey, there are probably bigger jackasses that have been knighted by The Queen of England and they are referred to as "sir" LOL. Paul McCartney "not" being one of them; then again, I never met him but he "was" a musical genius.

You make a good point, i could have googled first but there is one good thing about posting besides getting our own answers; that is that other people can benefit from the knowledge as well  :-)

I'm not sure I know Kerry but if Keith helped develop it, I have full trust in its functionality.

That guy is really good!

Mark

ML

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #5 on: June 13, 2007, 04:22:41 PM »

WOW

I just looked at it; it seems like an offal lot to go through to write a few paths to the registry.

Know what might be a better idea? I am sure this can be done although I am not immediately sure how.

I know in The API there are about 3 paths that I could not find but of course are in the registry.

So, I could write to the registry using a VBSCript (see above) then execute it from VBA, what do you think?

Off hand, do you know how I can execute the script (vbs) via VBA?

Thank you

Mark

Jeff_M

  • King Gator
  • Posts: 4040
  • C3D user & customizer
Re: Writing to The REgistry with VBA???
« Reply #6 on: June 13, 2007, 04:42:47 PM »
Hi Mark,
The code **LINK** I posted in the thread you were trying this in VBScript** is an example of what I use in VBA. Just be sure to go to Tools->References and add a reference to the "Windows Script Host Object Model"

This then works:
Code: [Select]
Sub SheetSetTemplatePath_WORKING()

Dim WshShell As New WshShell
Dim curver, locale, cprofile
Dim vname  '= Value Name
Dim vdata  '= Value Data

'Set WshShell = WScript.CreateObject("WScript.Shell")
'Set WshNetwork = WScript.CreateObject("WScript.Network")

vname = "SheetSetTemplatePath"


'This reads the currently installed and last accesed version of AutoCAD
curver = WshShell.RegRead("HKCU\Software\Autodesk\AutoCAD\curver")
'There is an additional value under that registry key, it is unique and must be grabbed from here, or else you won't know the location of the profile
locale = WshShell.RegRead("HKCU\Software\Autodesk\AutoCAD\" & curver & "\curver")
'This Key holds only the current profile
cprofile = WshShell.RegRead("HKCU\Software\Autodesk\AutoCAD\" & curver & "\" & locale & "\Profiles\")


'New Path Goes Here
vdata = "I:\Path\Template"


'Write The VName and VData (Support Path)
WshShell.RegWrite "HKCU\Software\Autodesk\AutoCAD\" & curver & "\" & locale & "\Profiles\" & _
cprofile & "\General\" & vname, vdata

'Return the results:
'MsgBox "The Path for " & vname & vbCrLf & vdata & vbCrLf & "has been written to" & vbCrLf & _
'"AutoCAD - " & curver & "," & vbCrLf & "Profile - " & cprofile


End Sub

Dnereb

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #7 on: June 13, 2007, 04:45:45 PM »
Just use the class....

adjust the default path and key to your need (I've used it for Web registration)
BTW: Keith = Keith Brown
Give Jeff Mischlers advice a serious thought (he's just below R. the wonder llama in my list... BTW what happened to the drowned cat?)

the class I've posted is a all purpose thingy. it is fast and able to writ to any chapter in the registry.
as said API's look realy hard but they are just functions with a speed advantage in general.
I personally won't dive in VB-script because I foresee VB.NET/ASP.NET will be the follow up on VBA and VB-script. But I'm famous for getting things wrong.
 
« Last Edit: June 13, 2007, 04:57:43 PM by Dnereb »

ML

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #8 on: June 13, 2007, 04:58:22 PM »

Jeff,

I must have missed that before.
Duh! That makes too much sense; that is why I missed it  :-D
So, as long as I turn on that type library I should be OK

You did a very nice job with your code, however the code I posted will grab the last accessed and installed version of ACAD and the current profile.
So, if you try the code I posted, you will not need to hard code the below info, it will automatically picked up.
Code: [Select]
R16.2\ACAD-4008:409\Profiles\Profile Name

I hope to branch it out in the near future to write to ALL profiles simultaneously, instead of just the current one or at least have the option to do so.

Thank you very much!

Mark

Quote
PS Thank you Keith "B" for help with The scripting code.

Jeff_M

  • King Gator
  • Posts: 4040
  • C3D user & customizer
Re: Writing to The REgistry with VBA???
« Reply #9 on: June 13, 2007, 05:33:31 PM »
You're welcome, Mark. And yes, I use something similar to what you are. That first bit of code was just thrown together to show how it could be used. I did test yours, too. It worked so well that I forgot to save my existing Path and it now reads what your code placed there  :oops: Fortunately you hadn't implemented setting all profiles at once :-)

One other thing to note:
Since I was working on an older drawing (R2002) that's what I tested the VBA code in. However, I'd earlier been using C3D2008 and had closed it. Your code made the changes to the C3D2008 profile, which I guess is OK unless you want to change the currently open/in use profile.

ML

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #10 on: June 13, 2007, 11:09:15 PM »

Hey Jeff

Yes, the code works real well, but I need to also branch it out further.
I want to write a whole VBSCript for writing the paths to the registry so that I don't even need to open ACAD at all.
Having said that, I tried to run it in VBA and it is still returning my variables as empty.

I went to references and checked type library Windows script Host Object Model but still the code is failing :(
There must be another type library that I need to check; can you please tell me what it is or what I am doing wrong?

Now, I think I see what is going on with running this code in VBA, at least as it is.
The code writes directly to the registry, however, ACAD does not update the registry until after you "close" ACAD.
You can easily test that out. Manually change a path in the registry, close ACAD and note that ACAD will over write your manual change. So, what I am saying is that after you close ACAD, it will overwrite the registry.

So, following that logic, it looked at C3D2008 as the "last" accessed version of ACAD, "not" 2002.
You ran the code in 2002 but after you closed 2002, 2002 overwrote the registry with the current paths in stored in 2002.

So, keeping this logic in mind, we can not use this code in VBA. The registry is not updated until after ACAD closes, therefore ACAD "must" be closed for this code to work effectively.

This takes us back to The script. The code I supplied is very good, but not good inside of VBA, at least the way I see it.
It was really written to work outside of ACAD.

Hope this makes sense?

So you are using Civil Design 2008? I am slowly learning Civil Design 2006; I am brand new to Civil Design.
I know my way around native AutoCAD but LDD and Civil Design is a whole new monster  :cry:
Have you ever examined the skdm file in Civil Design?

Mark

ML

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #11 on: June 13, 2007, 11:10:20 PM »

Jeff try placing the code into a vbs file; with ACAD closed, then run it.
You will see that it works just as planned

Mark

DaveW

  • Guest
Re: Writing to The REgistry with VBA???
« Reply #12 on: June 14, 2007, 09:32:54 PM »
This code works very well. Take the time to read through the different functions and their examples.
I believe it will work as long as it is in a module.

Code: [Select]
'
' Created by E.Spencer (elliot@spnc.demon.co.uk) - This code is public domain.
'
Option Explicit
Global sValue As String
'Security Mask constants
Public Const READ_CONTROL = &H20000
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const STANDARD_RIGHTS_READ = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
   KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
   KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
   KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE _
   Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
' Possible registry data types
Public Enum InTypes
   ValNull = 0
   ValString = 1
   ValXString = 2
   ValBinary = 3
   ValDWord = 4
   ValLink = 6
   ValMultiString = 7
   ValResList = 8
End Enum

Public Type typSrings
  Val1 As String
  Val2 As String
End Type



' Registry value type definitions
Public Const REG_NONE As Long = 0
Public Const REG_SZ As Long = 1
Public Const REG_EXPAND_SZ As Long = 2
Public Const REG_BINARY As Long = 3
Public Const REG_DWORD As Long = 4
Public Const REG_LINK As Long = 6
Public Const REG_MULTI_SZ As Long = 7
Public Const REG_RESOURCE_LIST As Long = 8
' Registry section definitions
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
' Codes returned by Reg API calls
Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259
' Registry API functions used in this module (there are more of them)
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

' This routine allows you to get values from anywhere in the Registry, it currently
' only handles string, double word and binary values. Binary values are returned as
' hex strings.
'
' Example
' Text1.Text = ReadRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\", "DefaultUserName")
'
Public Function ReadRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
Dim TStr1 As String, TStr2 As String
Dim i As Integer
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space$(2048)
lValueLength = Len(sValue)
lResult = RegQueryValueEx(lKeyValue, Key, 0&, lDataTypeValue, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
   If lDataTypeValue = REG_DWORD Then
      td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
      sValue = Format$(td, "000")
   End If
   If lDataTypeValue = REG_BINARY Then
       ' Return a binary field as a hex string (2 chars per byte)
       TStr2 = ""
       For i = 1 To lValueLength
          TStr1 = Hex(Asc(Mid(sValue, i, 1)))
          If Len(TStr1) = 1 Then TStr1 = "0" & TStr1
          TStr2 = TStr2 + TStr1
       Next
       sValue = TStr2
   Else
      sValue = Left$(sValue, lValueLength - 1)
   End If
Else
   sValue = "Not Found"
End If
lResult = RegCloseKey(lKeyValue)
ReadRegistry = sValue
End Function

' This routine allows you to write values into the entire Registry, it currently
' only handles string and double word values.
'
' Example
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValString, "NewValueHere"
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValDWord, "31"
'
Public Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, ByVal ValType As InTypes, ByVal Value As Variant)
Dim lResult As Long
Dim lKeyValue As Long
Dim InLen As Long
Dim lNewVal As Long
Dim sNewVal As String
On Error Resume Next
lResult = RegCreateKey(Group, Section, lKeyValue)
If ValType = ValDWord Then
   lNewVal = CLng(Value)
   InLen = 4
   lResult = RegSetValueExLong(lKeyValue, Key, 0&, ValType, lNewVal, InLen)
Else
   ' Fixes empty string bug - spotted by Marcus Jansson
   If ValType = ValString Then Value = Value + Chr(0)
   sNewVal = Value
   InLen = Len(sNewVal)
   lResult = RegSetValueExString(lKeyValue, Key, 0&, 1&, sNewVal, InLen)
End If
lResult = RegFlushKey(lKeyValue)
lResult = RegCloseKey(lKeyValue)
End Sub

' This routine enumerates the subkeys under any given key
' Call repeatedly until "Not Found" is returned - store values in array or something
'
' Example - this example just adds all the subkeys to a string - you will probably want to
' save then into an array or something.
'
' Dim Res, NewLine As String
' Dim i As Long
' Res = ReadRegistryGetSubkey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", i)
' NewLine = ""
' Do Until Res = "Not Found"
'   Text1.Text = Text1.Text & NewLine & Res
'   i = i + 1
'   Res = ReadRegistryGetSubkey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", i)
'   NewLine = Chr(13) & Chr(10)
' Loop

Public Function ReadRegistryGetSubkey(ByVal Group As Long, ByVal Section As String, Idx As Long) As String
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space$(2048)
lValueLength = Len(sValue)
lResult = RegEnumKey(lKeyValue, Idx, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
   sValue = Left$(sValue, InStr(sValue, Chr(0)) - 1)
Else
   sValue = "Not Found"
End If
lResult = RegCloseKey(lKeyValue)
ReadRegistryGetSubkey = sValue
End Function

' This routine allows you to get all the values from anywhere in the Registry under any
' given subkey, it currently only returns string and double word values.
'
' Example - returns list of names/values to multiline text box
' Dim Res As Variant
' Dim i As Long
' Res = ReadRegistryGetAll(HKEY_CURRENT_USER, "Software\Microsoft\Notepad", i)
' Do Until Res(2) = "Not Found"
'    Text1.Text = Text1.Text & Chr(13) & Chr(10) & Res(1) & " " & Res(2)
'    i = i + 1
'    Res = ReadRegistryGetAll(HKEY_CURRENT_USER, "Software\Microsoft\Notepad", i)
' Loop
'
Public Function ReadRegistryGetAll(ByVal Group As Long, ByVal Section As String, Idx As Long) As Variant
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long
Dim lValueLength As Long, lValueNameLength As Long
Dim sValueName As String ', sValue As String
Dim td As Double
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space$(2048)
sValueName = Space$(2048)
lValueLength = Len(sValue)
lValueNameLength = Len(sValueName)
lResult = RegEnumValue(lKeyValue, Idx, sValueName, lValueNameLength, 0&, lDataTypeValue, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
   If lDataTypeValue = REG_DWORD Then
      td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
      sValue = Format$(td, "000")
   End If
   sValue = Left$(sValue, lValueLength - 1)
   sValueName = Left$(sValueName, lValueNameLength)
Else
   sValue = "Not Found"
End If
lResult = RegCloseKey(lKeyValue)
' Return the datatype, value name and value as an array
ReadRegistryGetAll = Array(lDataTypeValue, sValueName, sValue)
End Function

' This routine deletes a specified key (and all its subkeys and values if on Win95) from the registry.
' Be very careful using this function.
'
' Example
' DeleteSubkey HKEY_CURRENT_USER, "Software\My Name\My App"
'
Public Function DeleteSubkey(ByVal Group As Long, ByVal Section As String) As String
Dim lResult As Long, lKeyValue As Long
On Error Resume Next
lResult = RegOpenKeyEx(Group, vbNullChar, 0&, KEY_ALL_ACCESS, lKeyValue)
lResult = RegDeleteKey(lKeyValue, Section)
lResult = RegCloseKey(lKeyValue)
End Function

' This routine deletes a specified value from below a specified subkey.
' Be very careful using this function.
'
' Example
' DeleteValue HKEY_CURRENT_USER, "Software\My Name\My App", "NewSubKey"
'
Public Function DeleteValue(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String
Dim lResult As Long, lKeyValue As Long
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
lResult = RegDeleteValue(lKeyValue, Key)
lResult = RegCloseKey(lKeyValue)
End Function
« Last Edit: June 14, 2007, 09:34:31 PM by DaveW »