VB Snippet - Register / unRegister dll/ocx thru Code

[James Stanich]

' REGISTERS ACTIVE X
 
Shell "REGSVR32 -S \ACTIVEXPATH\DLL OR OCX NAME"
 
 
' UNREGISTERS ACTIVE X
 
Shell "REGSVR32 -S -U \ACTIVEXPATH\DLL OR OCX NAME"
 
' - S = DON'T SHOW DIALOG BOX
 
' - U  = UNREGISTER

[CagedConfession]

I am trying to put this in a simple program. That will allow users to search for the file on there hard drive and load its location into a textbox. For instance, When the file is loaded Text1 tells the complete path to the file and the file name. I am trying to get this code to register the file using

Private Sub Command1_Click()
Shell "REGSVR32 -S\" & Text1.Text 
End Sub

I take it i'm doing this wrong...Any help would be greatly appreciated.....thx

[Hawk]

-You will need a text1, list1 and command1 on your form.
-You will need to reference "Microsoft Scripting Runtime"
-You will need to type in the name of the dll or ocx file that you are searching for. After that, click on command1 to search.
-List1 will shows all location this file existed.

Option Explicit

Dim mblnEnd  As Boolean
Private Sub Command1_Click()
    Dim strPath As String
    strPath = InputBox("Enter the starting path.", "Path", "C:\")
    mblnEnd = False
    
    List1.Clear
    Call sFindFile(strPath)
    
    Me.MousePointer = vbDefault
    MsgBox "Done Searching"
End Sub

Private Sub sFindFile(strFolder As String)
    Me.MousePointer = vbHourglass
    If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
    
    Dim FSO As New FileSystemObject
    If FSO.FolderExists(strFolder) = False Then Exit Sub
    
    Dim strFullFile As String
    Dim fldFile As File
    On Error GoTo Error_Handler
    For Each fldFile In FSO.GetFolder(strFolder).Files
        If LCase(fldFile.Name) = LCase(Text1.Text) Then
            List1.AddItem fldFile.Path       'Add every time there is a match
            strFullFile = Chr$(34) & fldFile.Path & Chr$(34)
            If MsgBox("Do you want to register this file?" & vbCrLf & strFullFile, vbYesNo) = vbYes Then
                Call Shell("Regsvr32.exe /s " & strFullFile)
            End If
            
            If MsgBox("Continue to search for other copies of this file?" & vbCrLf & Text1.Text, vbYesNo) = vbNo Then
                mblnEnd = True
            End If
            
            Exit For    'No need to check other files
        End If
    Next
    Set fldFile = Nothing
    
    'PURPOSE: Check for subfolders
    Dim fldSubFolder As Folder
    For Each fldSubFolder In FSO.GetFolder(strFolder).SubFolders
        If mblnEnd = True Then Exit Sub
        
        Call sFindFile(fldSubFolder.Path)       'Recursive
    Next
    Set fldSubFolder = Nothing
    Set FSO = Nothing
    Exit Sub
    
Error_Handler:
    Debug.Print "System Directory - Unable to check in this directory: "
    Debug.Print strFolder
End Sub

[CagedConfession]

Thanks, i will try that out.

[CagedConfession]

I'm getting an Error in the Dim Statement for
Dim FSO as New FileSystemObject

Private Sub sFindFile(strFolder As String)
    Me.MousePointer = vbHourglass
    If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
    
    Dim FSO As New FileSystemObject
    If FSO.FolderExists(strFolder) = False Then Exit Sub
    
    Dim strFullFile As String
    Dim fldFile As File
    On Error GoTo Error_Handler
    For Each fldFile In FSO.GetFolder(strFolder).Files
        If LCase(fldFile.Name) = LCase(Text1.Text) Then
            List1.AddItem fldFile.Path       'Add every time there is a match
            strFullFile = Chr$(34) & fldFile.Path & Chr$(34)
            If MsgBox("Do you want to register this file?" & vbCrLf & strFullFile, vbYesNo) = vbYes Then
                Call Shell("Regsvr32.exe /s " & strFullFile)
            End If
            
            If MsgBox("Continue to search for other copies of this file?" & vbCrLf & Text1.Text, vbYesNo) = vbNo Then
                mblnEnd = True
            End If
            
            Exit For    'No need to check other files
        End If
    Next
    Set fldFile = Nothing
    
    'PURPOSE: Check for subfolders
    Dim fldSubFolder As Folder
    For Each fldSubFolder In FSO.GetFolder(strFolder).SubFolders
        If mblnEnd = True Then Exit Sub
        
        Call sFindFile(fldSubFolder.Path)       'Recursive
    Next
    Set fldSubFolder = Nothing
    Set FSO = Nothing
    Exit Sub
    
Error_Handler:
    Debug.Print "System Directory - Unable to check in this directory: "
    Debug.Print strFolder
End Sub

[Hawk]

Actually, I should have left that line on a module level so it does not have to recreate the dim for every sub folder.

Back to your problem. Did you reference "Microsoft Scripting Runtime"?

[CagedConfession]

excuse the no0b coming out in me. But i've never delt with Microsoft Scripting Refrence. So could u please be more detailed as to what this is......Thankx

[Hawk]

No problem.

Go up to the Project Menu and click on References. Once the dialog box open, scroll down to that and click on "Microsoft Scripting Runtime". Done!

[chil]

This little script works great and registers the DLL that I want.
After reviewing my Project References, The DLL that I want is listed. Great!

[phrozeman]

i use this class to register DLL/OCX

no regsvr32 required!!!

Usage

Dim reg As RegService.clsRegDLL
 
Private Sub Command1_Click()
Dim menum As Status
Set reg = New RegService.clsRegDLL
If reg.RegisterComponent(Trim$(Text1.Text), DllRegisterServer) = 5 Then MsgBox "Successfull!"
End Sub