rjplante
Well-known Member
- Joined
- Oct 31, 2008
- Messages
- 574
- Office Version
- 365
- Platform
- Windows
I have a macro (listed below) that uses the number entered into a cell (A1 for example), which fills out a partial subdirectory in a second cell (B1). The macro should search this subdirectory in B1 for the number in A1 and then obtain the full name of the folder that contains that information, and paste that folder directory name into cell C1. This directory information is used to build a final directory path (found in D1) that is used to save the file in.
A1 = 2507
B1 = T:/Projects/2500
C1 = (filled in from macro) T:/Projects/2507 Company Name/
D1 = T:/Projects/2507 Company Name/Data Files/2507 - My Spreadsheet.xlsm
The macro run on my computer just fine, but fails on the computers of the end user. When they run it, they get a Run-time error '52': bad file name or number, and it fails on this line: "If ((GetAttr(lPath & DirFile) And vbDirectory) = 16) Then"
I do not know why it would work on one computer and not the rest. From what I can tell, they are running the same version of Excel I am using. Is there another way to write this macro or a way to edit the line that is causing the failure?
I appreciate the help.
NOTE: The Exit Do in the middle of the loop was originally just the word "End". This was causing the macro to hang and crash Excel. When I changed it to "Exit Do", it worked fine.
A1 = 2507
B1 = T:/Projects/2500
C1 = (filled in from macro) T:/Projects/2507 Company Name/
D1 = T:/Projects/2507 Company Name/Data Files/2507 - My Spreadsheet.xlsm
The macro run on my computer just fine, but fails on the computers of the end user. When they run it, they get a Run-time error '52': bad file name or number, and it fails on this line: "If ((GetAttr(lPath & DirFile) And vbDirectory) = 16) Then"
I do not know why it would work on one computer and not the rest. From what I can tell, they are running the same version of Excel I am using. Is there another way to write this macro or a way to edit the line that is causing the failure?
I appreciate the help.
NOTE: The Exit Do in the middle of the loop was originally just the word "End". This was causing the macro to hang and crash Excel. When I changed it to "Exit Do", it worked fine.
VBA Code:
Option Explicit
Dim xfolders As New Collection
Dim i As Long
Sub Search_for_a_folder()
ActiveSheet.Unprotect Password:="dmt"
Dim sPath As String
Sheets("Main Page").Range("C1").ClearContents
i = 1
Call AddSubDir(Range("B1").Value)
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="dmt"
End Sub
'
Sub AddSubDir(lPath As Variant)
ActiveSheet.Unprotect Password:="dmt"
Dim SubDir As New Collection
Dim DirFile As Variant
Dim sd As Variant
If Right(lPath, 1) <> "\" Then lPath = lPath & "\"
DirFile = Dir(lPath & "*", vbDirectory)
Do While DirFile <> ""
If DirFile <> "." And DirFile <> ".." Then
If ((GetAttr(lPath & DirFile) And vbDirectory) = 16) Then
If InStr(1, DirFile, Range("A1").Value, vbTextCompare) Then
Range("C1" & i).Value = lPath & DirFile
'i = i + 1
Exit Do 'Formerly End
End If
SubDir.Add lPath & DirFile
End If
End If
DirFile = Dir
Loop
For Each sd In SubDir
xfolders.Add sd
Call AddSubDir(sd)
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="dmt"
End Sub