View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone Jim Cone is offline
external usenet poster
 
Posts: 3,290
Default How to look for the Folder Path using macro????

Or maybe this...
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(color sort, compare, unique, thesaurus and other add-ins)


Sub DoesItExist()
Call IsFolderThere("*Connection*", "C:\Program Files")
End Sub

Private Function IsFolderThere(ByRef strFolder As String, _
ByRef strPath As String) As Boolean
'Jim Cone - San Francisco, USA - May 2006
'Requires project reference to "Microsoft Scripting Runtime" library
'Not recommended to search an entire drive, unless additional code is
'created to handle the error from the System Volume folder.
'Determines whether a folder exists in a specific path.
On Error GoTo ScriptErr
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim strMsg As String

Application.StatusBar = "FINDING FOLDER"
'Bring it to life...
Set objFSO = New Scripting.FileSystemObject

'Check for top folder
On Error Resume Next
Set objFolder = objFSO.GetFolder(strPath)
If Err.Number < 0 Then
MsgBox "No Top Folder:"
GoTo FinishUp
End If
On Error GoTo ScriptErr

'Check all of the sub folders.
Call CheckSubFolders(objFolder.SubFolders, strFolder, strMsg)
If Len(strMsg) Then
MsgBox "Folder path is: " & strMsg
Else
MsgBox "Cannot find folder " & strFolder & " "
End If
FinishUp:
On Error Resume Next
Application.StatusBar = False
Set objFSO = Nothing
Set objFolder = Nothing
Exit Function

ScriptErr:
MsgBox "Error " & Err.Number & " " & Err.Description
GoTo FinishUp
End Function

'Recursive function calls itself in order to scan subfolder folders.
Private Function CheckSubFolders(ByRef sFolders As Scripting.Folders, _
ByRef strFolder As String, ByRef strMsg As String) As Boolean
Dim objSubFolder As Scripting.Folder
Dim strPath As String
For Each objSubFolder In sFolders
If objSubFolder.Name Like strFolder Then
strMsg = objSubFolder.Path & " "
Exit Function
ElseIf Len(strMsg) = 0 Then
Call CheckSubFolders(objSubFolder.SubFolders, strFolder, strMsg)
End If
Next 'objsubfolder
Set objSubFolder = Nothing
End Function
'------------------


"Jac"
wrote in message
Hi,
I would like to save some files in a particular folder, for example
(Ven_Folder) in my computer system; but this folder may be transffered to
another directory time after time. So instead of using the absolute path to
fix the file saving location; I would pretty much wish that there could have
a way the macro can help to lookup for the folder path before those mentioned
files are saved.

I have tried out the Dir statement but it can only work in the 1st loop in
looping control structure. Thus, anyone can help in this matter.......????

Thanking in advanced.