Adding an ActiveX Button that hyperlinks to a file location

[Jimmy1772]

I'm trying to add a button to a folder if it exists. I want it to also check if the folder doesn't exist and delete the button if not.

This is what I have so far. Some of my variables are global so they're not defined in the function

Option Explicit

Dim objCMDBtn As Object
Dim ButtonLocation As String
Dim ButtonAddress As Range
Dim FSOSubfolder As Object
Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim Folderpath As String

Function AddCADButton(DestRow As String)

'If this isn't the template workbook then check if there is a button for the cad folder, if a cad folder exists.
'If there is a cad button and no cad folder then delete the button

Set FSOLibrary = CreateObject("Scripting.FileSystemObject")

Folderpath = ThisWorkbook.Path

Set FSOFolder = FSOLibrary.getfolder(Folderpath)

For Each FSOSubfolder In FSOFolder.subfolders

    If FSOSubfolder.Name = "CAD" Then
    'there is CAD data

    ButtonLocation = desttable.ListColumns("CAD").DataBodyRange.Cells(DestRow).Address
    Set ButtonAddress = wsDest.Range(ButtonLocation)
    Set objCMDBtn = wsDest.OLEObjects.Add(classtype:="Forms.CommandButton.1", _
                    link:=False, _       ' Can I add a hyperlink to the file location here?
                    Displayasicon:=False, _
                    Left:=ButtonAddress.Left, _
                    Top:=ButtonAddress.Top, _
                    Width:=ButtonAddress.Width, _
                    Height:=ButtonAddress.Height)
                    
                    
                    
                    With objCMDBtn
                        .Name = "test"  ' This line will show up if I check objCMDBTN.name in the Immediate window but it doesn't actually rename the button
                        .Object.Caption = "CAD"
                        With .Object.Font
                            .Name = "Arial"
                            .Bold = "True"
                            .Size = "10"
                            .Italic = False
                            .Underline = False
                         End With
                    End With
                
                    
'I haven't gotten far enough to see if this will work.        
           
    Else
    'there is no CAD data
    
    'delete button if it exists
    For Each objCMDBtn In wsDest.OLEObjects
        If TypeName(objCMDBtn.Object) = ProcessArea & " " & ProcessNo Then objCMDBtn.Delete
        Exit For
    Next
            
    
    
    
    End If
    
Next



End Function

 

[GWteB]

link:=False, _       ' Can I add a hyperlink to the file location here?

No, it has to be a boolean. In this situation FALSE since you are using a ClassType to add a button. There is no file to link with, so FALSE.

 .Name = "test"  ' This line will show up if I check objCMDBTN.name in the Immediate window but it doesn't actually rename the button

Yes it does, otherwise it would not show up in the Immediate Window. Add the following to your code (temporary) to convince yourself.

MsgBox objCMDBtn.Name

For Each objCMDBtn In wsDest.OLEObjects
If TypeName(objCMDBtn.Object) = ProcessArea & " " & ProcessNo Then objCMDBtn.Delete
Exit For
Next

This will not work, replace this part by something like this:

    'delete button if it exists
    For Each objCMDBtn In wsDest.Shapes
        If objCMDBtn.DrawingObject.progID = "Forms.CommandButton.1" Then
        
        ' in here some code to check wether it's the right button to delete

        End If
    Next