Private Const HKEY_CLASSES_ROOT = &H80000000Private Const HKEY_CURRENT_CONFIG = &H80000005Private Const HKEY_CURRENT_USER = &H80000001Private Const HKEY_LOCAL_MACHINE = &H80000002Private Const HKEY_USERS = &H80000003'Save the specified registry's key and (optionally) its subkeys to a REG file ' that can be loaded later' - hKey is the root key' - sKeyName is the key to save to the file' - sRegFile is the target file where the text will be saved' - bIncludeSubKeys specifies whether the routine will save also the subkeys' - bAppendToFile specifies wheter the generated text will be appended to an ' existent file'Example:'  SaveRegToFile HKEY_CURRENT_USER, "SoftwareMicrosoftVisual Basic6.0",'  "C:vb6.reg"'NOTE: this routine requires EnumRegistryKeys and EnumRegistryValuesExSub SaveRegToFile(ByVal hKey As Long, ByVal sKeyName As String, _    ByVal sRegFile As String, Optional ByVal bIncludeSubKeys As Boolean = True, _    Optional ByVal bAppendToFile As Boolean = False)        Dim handle As Integer    Dim sFirstKeyPart As String    Dim col As New Collection    Dim regItem As Variant    Dim sText As String    Dim sQuote As String    Dim sTemp As String    Dim sHex As String    Dim i As Long    Dim vValue As Variant    Dim iPointer As MousePointerConstants    Dim sValueName As String        sQuote = Chr$(34)        On Error Resume Next         'conver the hKey value to the descriptive string    Select Case hKey        Case HKEY_CLASSES_ROOT: sFirstKeyPart = "HKEY_CLASSES_ROOT"        Case HKEY_CURRENT_CONFIG: sFirstKeyPart = "HKEY_CURRENT_CONFIG"        Case HKEY_CURRENT_USER: sFirstKeyPart = "HKEY_CURRENT_USER"        Case HKEY_LOCAL_MACHINE: sFirstKeyPart = "HKEY_LOCAL_MACHINE"        Case HKEY_USERS: sFirstKeyPart = "HKEY_USERS"    End Select        'this can be a long operation    iPointer = Screen.MousePointer    Screen.MousePointer = vbHourglass        'if the text won't be appended, add the "REGEDIT4" header    If bAppendToFile = False Then        sText = "REGEDIT4" & vbCrLf & vbCrLf    Else        'add the same header if the text will be appended to an        'existent file that does not contain the header.         ' This works only if the file exists but is empty.        handle = FreeFile        Open sRegFile For Binary As #handle        ' read the string and close the file        sTemp = Space$(LOF(handle))        Get #handle, , sTemp        Close #handle        'if not found, add it        If InStr(1, sTemp, "REGEDIT4") = 0 Then            sText = "REGEDIT4" & vbCrLf & vbCrLf        End If    End If        'save the key name with the format [keyname]    sText = sText & "[" & sFirstKeyPart & sKeyName & "]" & vbCrLf        'get the collection with all the values under this key    Set col = EnumRegistryValuesEx(hKey, sKeyName)    For Each regItem In col        vValue = regItem(1)        Select Case regItem(2)            Case vbString                'if the value is a string, check if it's a path by looking if                 ' the 3 characters                'are in the form X:. If so, replace a single "" with "\"                If Left$(vValue, 3) Like "[A-Z,a-z]:" Then vValue = Replace _                    (vValue, "", "\")                'quote it                sTemp = sQuote & vValue & sQuote            Case vbLong                'if it's a long, save it with the format dword:num                sTemp = "dword:" & CLng(vValue)            Case vbArray + vbByte                'if it's an array of bytes, save it with the format hex:num1,                ' num2,num3,...                sTemp = "hex:"                For i = 0 To UBound(vValue)                    sHex = Hex$(vValue(i))                    'convert from long to hex                    If Len(sHex) < 2 Then sHex = "0" & sHex                    sTemp = sTemp & sHex & ","                Next                'remove the last comma                sTemp = Left$(sTemp, Len(sTemp) - 1)            Case Else                sTemp = ""        End Select        'get the value name: if the string is empty, take @,        '  else take that name and quote it        sValueName = IIf(Len(regItem(0)) > 0, sQuote & regItem(0) & sQuote, "@")        'save this line to the temporary text that will be saved        sText = sText & sValueName & "=" & sTemp & vbCrLf    Next    sText = sText & vbCrLf        handle = FreeFile    'open the target file with Append or Output mode,    '  according to the bAppendToFile parameter    If bAppendToFile Then        Open sRegFile For Append As #handle    Else        Open sRegFile For Output As #handle    End If    'save the text    Print #handle, sText;    Close #handle        'call recursively this routine to save all the subkeys,    '  if the bIncludeSubKeys param is true    If bIncludeSubKeys Then        Set col = EnumRegistryKeys(hKey, sKeyName)        For Each regItem In col            'note: the text will be added to the file just created for the            'values in the root key            SaveRegToFile hKey, sKeyName & "" & regItem, sRegFile, True, True        Next    End If        Screen.MousePointer = iPointer    End Sub