save as to specific directory (different paths)

[daniels012]

I need to hit a button. It then saves the file with the name I choose to a directory that could be different on each different computer, but the last part of the path is always the same "\dropbox\clients\".

Is this possible to find the wildcard of a path using code?

Something like:

If Dir(DBPath, vbDirectory) <> "" Then
                ActiveWorkbook.SaveAs DBPath & myFileName

DBPath = ?? Whatever wildcard code we can create
myFileName = Worksheets("Estimating").Range("A10").Value & ".xls"

Even if It could bring up the dialog box to save the file, that would be great. Then they can HIT ok to make sure it is going to the right place.

Thank You,
Michael D

 

[daniels012]

They might have:
C:\Documents\Bob\Dropbox\Clients\
or
C:\My Documents\Dave\Dropbox\Clients
or
C:\Dropbox\Clients

So this is why using the wildcard would be nice to find the proper path.

Thyank You

 

[shg]

Try this:

Function GetDir(ByVal sRoot As String, sPath As String) As String
    ' Returns a folder matching the pattern
    ' sRoot & "*" & sPath
    
    ' E.g., sRoot = "C:\", sPath ="\dropbox\clients"
    ' gives the pattern "C:\*\dropbox\clients"
    ' Requires a reference to Microsoft Scripting Runtime
    Dim oFSO        As Scripting.FileSystemObject
    Dim col         As Collection               ' working collection of folders
    Dim oSub        As Scripting.Folders        ' subfolders in a given folder
    Dim oFld        As Scripting.Folder         ' one folder among subfolders
    Dim sPatt       As String
 
    Set oFSO = New Scripting.FileSystemObject
    If Not oFSO.FolderExists(sRoot) Then Exit Function
 
    sPatt = LCase(sRoot & "*" & sPath & "*")
    Set col = New Collection
    Set oFSO = New Scripting.FileSystemObject
    col.Add sRoot
    
    ' for hidden folders:
    On Error Resume Next
 
    Do While col.Count
        Set oSub = oFSO.GetFolder(col(1)).SubFolders
        If oSub.Count Then
            If Err.Number Then
                ' hidden folder -- let it go
                Err.Clear
            Else
                For Each oFld In oSub
                    If LCase(oFld.Path) Like sPatt Then
                        GetDir = oFld.Path
                        Exit Function
                    End If
                    col.Add oFld.Path
                Next oFld
            End If
        End If

        col.Remove 1
    Loop
End Function

E.g., (as a UDF),

=GetDir("C:\", "dropbox\clients")

Tightening up the root (e.g, "C:\Documents and Setting\username") would make it faster.

 

[daniels012]

Any way to do this as code instead of a user defined function.

 

[Joe4]

Any way to do this as code instead of a user defined function.

A User Defined Function is code, and can be used/called in VBA code like other functions available in VBA.

 

[daniels012]

OK Great!
How?
HOw can I put this UDF in my code?
I want to open a dialog box in the path dropbox\clients

Thank You,
Michael

 

[daniels012]

Tried the UDF and get an error on this line:
Dim oFSO As Scripting.FileSystemObject

I am sure I need to add scripting,How do I do that?

Michael

 

[shg]

Tools > References, locate and tick Microsoft Scripting Runtime.