VBA macro code for Excel that appears to be used for creating hyperlinks to folders

[agi1098]

I would like to skip checking CD or DVD drives in the following code.

"A" is the drive I mentioned as Sample. If drive "A" is the CD or DVD drive of another user, I would prefer not to check it

Please anyone help me..

Sub Document_Register_From_ABC COMPANY()
' Declare variables
Dim rng As Range
Dim cell As Range
Dim folderPath As String
Dim folderName As String
Dim ws As Worksheet

' Set worksheet
Set ws = ThisWorkbook.Worksheets("Document Register")

' Set column ranges
Set rng = ws.Range("R8:R3000")

' Loop through cells in column R and create hyperlinks in column S
For Each cell In rng
folderName = cell.Value
If folderName <> "" Then
' Check if the cell value matches a folder name in the first path
If Len(Dir("A:\02 - Transmittals\Transmittals from ABC\" & folderName, vbDirectory)) > 0 Then
' Create hyperlink to the folder in the cell to the right (column S)
ws.Hyperlinks.Add Anchor:=cell.Offset(0, 1), Address:="A:\02 - Transmittals\Transmittals from ABC\" & folderName

ElseIf Len(Dir("A:\600-Series\MJ-635\635-Transmittals\Transmittals from ABC\" & folderName, vbDirectory)) > 0 Then
' If not found in the first or second path, check the third path and create hyperlink
ws.Hyperlinks.Add Anchor:=cell.Offset(0, 1), Address:="A:\600-Series\MJ-635\635-Transmittals\Transmittals from ABC\" & folderName

End If
End If
Next cell

End Sub

[#2]

@agi1098 

To skip checking the CD or DVD drives in your VBA macro code for Excel, you can add a condition to exclude drive "A" if it's a CD or DVD drive. You can do this by checking the drive type before attempting to create hyperlinks. Here is how you can modify your code to skip CD or DVD drives:

Vba code:

Sub Document_Register_From_ABC_COMPANY()
    ' Declare variables
    Dim rng As Range
    Dim cell As Range
    Dim folderPath As String
    Dim folderName As String
    Dim ws As Worksheet

    ' Set worksheet
    Set ws = ThisWorkbook.Worksheets("Document Register")

    ' Set column ranges
    Set rng = ws.Range("R8:R3000")

    ' Loop through cells in column R and create hyperlinks in column S
    For Each cell In rng
        folderName = cell.Value
        If folderName <> "" Then
            ' Check if the cell value matches a folder name in the first path
            If Len(Dir("A:\02 - Transmittals\Transmittals from ABC\" & folderName, vbDirectory)) > 0 Then
                ' Check if drive "A" is not a CD or DVD drive
                If GetDriveType("A") <> 5 Then
                    ' Create hyperlink to the folder in the cell to the right (column S)
                    ws.Hyperlinks.Add Anchor:=cell.Offset(0, 1), Address:="A:\02 - Transmittals\Transmittals from ABC\" & folderName
                End If
            ElseIf Len(Dir("A:\600-Series\MJ-635\635-Transmittals\Transmittals from ABC\" & folderName, vbDirectory)) > 0 Then
                ' Check if drive "A" is not a CD or DVD drive
                If GetDriveType("A") <> 5 Then
                    ' If not found in the first or second path, check the third path and create hyperlink
                    ws.Hyperlinks.Add Anchor:=cell.Offset(0, 1), Address:="A:\600-Series\MJ-635\635-Transmittals\Transmittals from ABC\" & folderName
                End If
            End If
        End If
    Next cell
End Sub

Function GetDriveType(ByVal driveLetter As String) As Long
    ' Function to determine drive type
    GetDriveType = GetDrive(driveLetter)
End Function

Declare Function GetDrive Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

The code is untested, please save your project before you try the code.

In this code, the GetDriveType function checks the drive type of drive "A" using the GetDrive API. If the drive type is 5 (CD or DVD drive), it skips creating the hyperlink for that folder. Otherwise, it proceeds to create the hyperlink. This modification ensures that CD or DVD drives are not checked in your code. The text and steps were edited with the help of AI.

My answers are voluntary and without guarantee!

Hope this will help you.

Was the answer useful? Mark as best response and Like it!

This will help all forum participants.