This is quite the rabbit-hole. More dependencies:
Code:Public Const ERR_CANCELLED_BY_USER As Long = 747 ' Error returned when user selects cancel in a common dialog. Public Function GetFolder(ByRef FileSpec As String) As String Dim FSO As New FileSystemObject On Error GoTo errHandler CallStack.Add NAME & ".GetFolder(Public Function)" GetFolder = vbNullString ' Returns the path without the FileSpec. GetFolder = NormalizePath(FSO.GetParentFolderName(FileSpec)) CleanUp: Set FSO = Nothing CallStack.DeleteProcedureCall Exit Function errHandler: Dim nErrorHandlerResult As Long Dim sError As String Dim nErr As Long Dim Parameters(0) As String sError = Error nErr = Err Parameters(0) = "FileSpec = " & FileSpec nErrorHandlerResult = ErrorHandler(sError, nErr, ParameterString(Parameters), NAME & ".GetFolder(Public Function)") Resume CleanUp End Function Public Function CreateFolder(ByVal FolderName As String, PromptForFolderCreation As Boolean) As Long Dim nResult As Long Dim nErr As Long Dim FSO As New FileSystemObject ' Returns Error Code. On Error GoTo errHandler CallStack.Add NAME & ".CreateFolder(Public Function)" nErr = 0 ' Function should be called any time a user is prompted for a filename to save to. ' If the folder exists, the functions does nothing and exits. If FSO.FolderExists(FolderName) Then GoTo CleanUp If Not PromptForFolderCreation Then nResult = CreatePath(FolderName) If nResult <> 0 Then Err.Raise nResult Else nResult = MsgBoxA("The folder " & FolderName & " does not exist. Do you want to create it?", vbYesNo + vbQuestion, App.Title) Select Case nResult Case vbYes nResult = CreatePath(FolderName) If nResult <> 0 Then Err.Raise nResult Case vbNo nErr = ERR_CANCELLED_BY_USER GoTo CleanUp End Select End If CleanUp: CreateFolder = nErr Set FSO = Nothing CallStack.DeleteProcedureCall Exit Function errHandler: Dim nErrorHandlerResult As Long Dim sError As String Dim Parameters(2) As String sError = Error nErr = Err Parameters(0) = "FolderName = " & FolderName Parameters(1) = "PromptForFolderCreation = " & CStr(PromptForFolderCreation) Parameters(2) = "nResult = " & CStr(nResult) If nResult = 0 Then nErrorHandlerResult = ErrorHandler(sError, nErr, ParameterString(Parameters), NAME & ".CreateFolder(Public Function)") End If Resume CleanUp End Function Public Function NormalizePath(ByVal FolderName As String) Dim s As String CallStack.Add NAME & ".NormalizePath(Public Function)" s = TrimNull(Trim$(FolderName)) If Len(s) = 0 Then GoTo CleanUp If Right$(s, 1) <> BACK_SLASH Then s = s & BACK_SLASH NormalizePath = s CleanUp: CallStack.DeleteProcedureCall End Function




Reply With Quote