Creating Hyperlink & Folder on creation of new cell entry

[pmac777]

Hello everyone!

I need some help -

I'm working on a Stores Database and have a working Userform. I have 7 columns which populate on Userform entry. On the 7th column it enters a unique number when a new entry is added.

What I would like to do is on every entry of the Userform and a unique number is created id like it to create a folder into C:/Temp for example and then hyperlink to that folder in the 7th Column.

Private Sub cmd_add_Click()

Dim tbl As ListObject
Dim WS As Worksheet
Dim lrow As Range
Dim lrow2 As Long

Set tbl = Sheets("PartsData").ListObjects("Parts")

    If tbl.ListRows.Count > 0 Then

        Set lrow = tbl.ListRows(tbl.ListRows.Count).Range
        For col = 1 To lrow.Columns.Count
            If Trim(CStr(lrow.Cells(1, col).Value)) <> "" Then
                tbl.ListRows.Add
                Exit For
                
            End If
            
        Next col
        
    Else
    
    tbl.ListRows.Add
    
    End If
    

    lrow2 = tbl.ListRows.Count

     tbl.DataBodyRange(lrow2, 1).Value = Cmb_Manufact.Value

     tbl.DataBodyRange(lrow2, 2).Value = txt_descript.Value

     tbl.DataBodyRange(lrow2, 3).Value = txt_manufact_no.Value

     tbl.DataBodyRange(lrow2, 4).Value = txt_Stard.Value
     
     tbl.DataBodyRange(lrow2, 5).Value = txt_qty.Value
     
     tbl.DataBodyRange(lrow2, 6).Value = txt_loc.Value
     
     tbl.DataBodyRange(lrow2, 7).Value = WorksheetFunction.Max(Range("G3:G65536")) + 1 'need to create this entry as hyperlink and creation of folder
     
     
              
    
'Clear txt boxes when part entered

        txt_descript.Value = ""
        txt_descript.Value = ""
        txt_manufact_no.Value = ""
        txt_Stard.Value = ""
        txt_qty.Value = ""
        txt_loc.Value = ""
    

End Sub

Private Sub cmd_cancel_Click()

    Unload Me

End Sub

Private Sub UserForm_Initialize()

    txt_manufact_no.Value = ""
    txt_descript.Value = ""
    txt_qty.Value = ""
    txt_Stard.Value = ""
    txt_loc.Value = ""
    
    With Cmb_Manufact

    .AddItem ""
    .AddItem "Siemens"
    .AddItem "Allen Bradley"
    .AddItem "Cognex"
    .AddItem "Vega"
    .AddItem "Beckoff"
    .AddItem "Eurotherm"
    .AddItem "Other.."
    
End With

End Sub

Hoping someone code help!

Many Thanks

PM

 

[severynm]

Creating a folder is accomplished with the MkDir method, and creating hyperlinks with Hyperlinks.Add on your cell. Hyperlink example:

Sheet3.Range("A1").Hyperlinks.Add Sheet3.Range("A1"),"C:\Temp"

It's usually good to do some error checking with MkDir, for example checking if the folder already exists (which you can find out if Dir returns a null string). For example from one of my projects:

    If Dir(folderPath, vbDirectory) = vbNullString Then
        ans = MsgBox("Folder does not exist. Create?", vbYesNo)
        If ans = vbYes Then
            MkDir folderPath
        Else
            Exit Sub
        End If
    End If