User Dialog Box for Save Address

[sassriverrat]

Good Afternoon,
A friend shot me this piece of code in my efforts to simplify a workbook. The code successfully opens a dialog box that allows the user to choose a "save" location, but I need this piece of code to spit the entire address into cell A1 and I've tried tweaking a few times to no success. Anyone have any ideas?

Public Function GetOutputDirectory() As String
 
  Dim retval As String 'Return Value
  
  Dim sMsg As String
  Dim cBits As Integer
  Dim xRoot As Integer
  
  Dim oShell As Object
  Set oShell = CreateObject("shell.application")

  sMsg = "Select a Folder To Output The Attachments To"
  cBits = 1
  xRoot = 17
  
  On Error Resume Next
      Dim oBFF
      Set oBFF = oShell.BrowseForFolder(0, sMsg, cBits, xRoot)
      If Err Then
        Err.Clear
        GetOutputDirectory = ""
        Exit Function
      End If
  On Error GoTo 0
  
  If Not IsObject(oBFF) Then
    GetOutputDirectory = ""
    Exit Function
  End If
  
  If Not (LCase(Left(Trim(TypeName(oBFF)), 6)) = "folder") Then
    retval = ""
  Else
    retval = oBFF.Self.Path
    
    'Make sure there's a \ on the end
    If Right(retval, 1) <> "\" Then
      retval = retval + "\"
    End If
  End If
  
  GetOutputDirectory = retval
  
End Function

Sub output_directory()

Dim outputDir As String

outputDir = GetOutputDirectory()
  If outputDir = "" Then
    MsgBox "You must pick an directory to save your files to. Exiting SaveAttachments.", vbCritical, "SaveAttachments"
    Exit Sub
  End If
    
End Sub[\code]

 

[Misca]

Add a couple of lines to the sub and you're done:

Sub output_directory()

Dim outputDir As String

outputDir = GetOutputDirectory()
  If outputDir = "" Then
    MsgBox "You must pick an directory to save your files to. Exiting SaveAttachments.", vbCritical, "SaveAttachments"
    Exit Sub
  Else
    Sheets("YourSheetNameHere").Range("A1").Value = outputDir     'Replace the YourSheetNameHere with the actual sheet name
  End If
 
End Sub

 

[sassriverrat]

Dang it....duh.

Thank you...I missed the obvious!