Forum Discussion
agi1098
Oct 06, 2023Copper Contributor
VBA macro code for Excel that appears to be used for creating hyperlinks to folders
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
- NikolinoDEGold Contributor
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.