The following code prompts for a full path or press E to invoke a dialog window typical to Microsoft to choose a “Save As” style windows path. Eventually an Excel file path that is fully valid and vetted will result.

Here are 2 basic ideas wrapped within eachother

a) Outer: Is there a valid filename (valid string) or did the user cancel (False),
b) Inner: Go get the filename via command line or optional dialog window – this might give garbage- hence, the above line has “valid”
Note we can ONLY do this because you already using the Excel libraries as you are writing an Excel file with this path. There is equiv. commands without this cheat.

You want to make your code contain TestVettedExcelName style code – then you can use the Functions with no issues.

[vb]

Sub TestVettedExcelName()
Dim name As Variant

name = GetVettedExcelName
<!–more–>
If name = False Then
‘ something went wrong
MsgBox (“No file selected or path is not valid”)
Else
MsgBox (“the name is: ” & name & “and is a valid string”)
End If

End Sub
[/vb]

[vb]
Function GetVettedExcelName() As Variant
‘will return a valid path OR false if the user cancelled

Dim FinalAnswer As Variant
FinalAnswer = False

Dim name As Variant
Dim fso As Object
Dim MyFile As String
Dim fp As String
Dim this As String
Dim stoop As Boolean
Dim Continue As Boolean
Continue = True

name = “” ‘ a starting point
While name <> False And Continue
name = GetExcelName()
If name = False Then
‘user cancelled
ElseIf name <> “” Then
Set fso = CreateObject(“Scripting.FileSystemObject”)

fp = StripFilename(CStr(name))

this = Dir(fp, vbDirectory)
If this = “” Then
MsgBox (“Path ‘” & name & “‘ invalid – specify whole path with excel filename”)
Beep
FinalAnswer = False

Else
‘Hey – all is OK.
Beep
FinalAnswer = name
Continue = False
End If
End If

Wend
GetVettedExcelName = FinalAnswer
End Function

Function StripFilename(sPathFile As String) As String

‘given a full path and file, strip the filename off the end and return the path
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)

StripFilename = fso.GetParentFolderName(sPathFile) & “\”

Exit Function

End Function
Function GetExcelName() As Variant
‘will return a fully vetted path if it is realistic
‘else will return a an empty string if the user aborts (“E”)

Dim FullPath As String
Dim stoop As Boolean
Dim existing As String
Dim FileToSave As Variant
‘try to get the path from the command line
FullPath = ThisDrawing.Utility.GetString _
(1, “Enter the full windows file path [E to exit, <enter> to use a dialog window]: <enter>”)

FullPath = Replace(FullPath, “/”, “\”)
If UCase(FullPath) = “E” Then
FullPath = “<none>”
Else
‘ The path could be a complete bunch of nonsense and not even be a valid directory or existing directory … check that later
If FullPath = “” Then
FileToSave = Excel.Application.GetSaveAsFilename(“temp.xlsx”, “Excel *.xls*(*.xls*),All *.*(*.*),”, 1, “Please choose a file location to save”, “Save”)
If FileToSave = False Then
‘user cancelled
FullPath = “<none>”
Else
‘user picked something and is likely NOT nonsense
FullPath = FileToSave
End If
stoop = True
Else
If InStr(1, FullPath, “\”) = 0 Then
‘ no path was entered so assume my docs directory
FullPath = Environ(“USERPROFILE”) & “\Documents\” & FullPath
End If
End If
End If

If FullPath = “<none>” Then
‘CANCELLED
GetExcelName = False

ElseIf FullPath <> “” Then
If Len(FullPath) > 3 Then
If LCase(Right(FullPath, 4)) = “.xls” Then
‘ all is ok
Else
If Len(FullPath) > 4 Then
If LCase(Right(FullPath, 5)) = “.xlsx” Then
‘ all is ok
Else
If (Right(FullPath, 1) <> “.”) Then
FullPath = FullPath + “.”
End If
FullPath = FullPath + “xlsx”
End If
End If

End If
Else
If (Right(FullPath, 1) <> “.”) Then
FullPath = FullPath + “.”
End If
FullPath = FullPath + “xlsx”
End If
GetExcelName = FullPath
End If

[/vb]

End Function