Hyperlinks sub folders file-CodePudding

Hello everyone yesterday ı try to do

Sub Hyperlinks()
Dim wks As Worksheet
Dim hl As Hyperlink
Const RootPath As String = "X:\EVEREST-2\EVEREST ERP\ÜRETİM\PDM SOLID DOSYA YOLU\"
Const SeriCol As Long = 3
Const NameCol As Long = 4
Const YearCol As Long = 24

Set wks = ActiveSheet

Dim r As Long: r = FirstRow
Dim FileBaseName As String: FileBaseName = ws.Cells(r, SeriCol)
Dim hl_name As String: hl_name = ws.Cells(r, NameCol)
Dim year As String: year = ws.Cells(r, YearCol)

Do Until Len(hl_name) = 0
    wks.Hyperlinks.Add ws.Cells(r, NameCol), Address:=(RootPath & year & "\" & FileBaseName & ".bat"TextToDisplay:=hl_name)
    r = r   1
Loop


MsgBox "Hyperlinks created.", vbInformation End sub

CodePudding user response：

Create Hyperlinks

' *** You want to reference the model cell before and at the end of the loop.

A Quick Fix

Option Explicit

Sub CreateHyperlinks()
    
    Const RootPath As String = "X:\EVEREST-2\EVEREST ERP\ÜRETIM\PDM SOLID DOSYA YOLU\"
    Const YearCol As String = "X"
    Const SerialCol As String = "C"
    Const ModelCol As String = "D"
    Const FirstRow As Long = 2
    
    Dim wks As Worksheet: Set wks = ActiveSheet ' improve!
    
    Dim r As Long: r = FirstRow
    Dim ModelCell As Range: Set ModelCell = wks.Cells(r, ModelCol) ' ***
    
    Dim FilePath As String
    Dim YearPath As String
    Dim Serial As String
    
    Do Until Len(CStr(ModelCell.Value)) = 0
        
        YearPath = CStr(wks.Cells(r, YearCol)) & "\"
        Serial = CStr(wks.Cells(r, SerialCol))
        FilePath = RootPath & YearPath & Serial & ".bat"
        
        wks.Hyperlinks.Add Anchor:=ModelCell, Address:=FilePath
        
        r = r   1
        Set ModelCell = wks.Cells(r, ModelCol) ' ***
    
    Loop

    MsgBox "Hyperlinks created.", vbInformation

End Sub

CodePudding user response：

There is a comma missing between ".bat" and TextToDisplay:

 Address:=(RootPath & year & "\" & FileBaseName & ".bat"TextToDisplay:=hl_name)

Note: There is no need to use the TextToDisplay parameter when the display text is the same as the anchor cell value.

Refactored Code

Sub Hyperlinks()
    Dim wks As Worksheet
    Dim hl As Hyperlink
    Const RootPath As String = "X:\EVEREST-2\EVEREST ERP\ÜRETIM\PDM SOLID DOSYA YOLU\"
    Const SeriCol As Long = 3
    Const NameCol As Long = 4
    Const YearCol As Long = 24

    Set wks = ActiveSheet

    Dim r As Long: r = FirstRow
    Dim FileBaseName As String: FileBaseName = ws.Cells(r, SeriCol)
    
    Dim year As String: year = ws.Cells(r, YearCol)
    Dim Address As String
    
    Do Until Len(hl_name) = 0
        Address = RootPath & year & "\" & FileBaseName & ".bat"
        wks.Hyperlinks.Add ws.Cells(r, NameCol), Address:=Address
        r = r   1
    Loop


    MsgBox "Hyperlinks Added"
End Sub

CodePudding user response：

ı fix it now it works

Sub Hyperlinks1()
Dim hl As Hyperlink
Const RootPath As String = "X:\EVEREST-2\EVEREST ERP\ÜRETİM\PDM SOLID DOSYA YOLU\"
Const SeriCol As Long = 3
Const NameCol As Long = 4
Const YearCol As Long = 24



Dim ws As Worksheet: Set ws = ActiveSheet
Dim r As Long: r = 4
Dim FileBaseName As String: FileBaseName = ws.Cells(r, SeriCol)
Dim hl_name As String: hl_name = ws.Cells(r, NameCol)
Dim year As String: year = ws.Cells(r, YearCol)
year = Right(year, 4)

Do Until Len(hl_name) = 0
With ws
 .Hyperlinks.Add Anchor:=.Cells(r, NameCol), _
 Address:=RootPath & year & "\" & FileBaseName & ".bat", _
 ScreenTip:="Click to open 3D Solid File", _
 TextToDisplay:=hl_name
End With
r = r   1
FileBaseName = ws.Cells(r, SeriCol)
hl_name = ws.Cells(r, NameCol)
year = ws.Cells(r, YearCol)
year = Right(year, 4)
Loop



MsgBox "Hyperlinks created.", vbInformation
End Sub