VB Snippet - Register / unRegister dll/ocx thru Code

VB Code:

' 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

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

Code:

---

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

-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.

Code:

---

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

---

Thanks, i will try that out.:)

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

VB Code:

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

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"?

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

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!

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!

i use this class to register DLL/OCX

no regsvr32 required!!!

Usage

VB Code:

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