Hey there guys, just a quick question here. I have an application that is reading a path from a text file and I want it to perform a task when the path is seen as valid and performing another task when the path is found as invalid. So far I have made do with this:
If txtPath.text = "" Then
MsgBox "The path you have set is invalid"
Else
MsgBox "You have a valid path"
End If
now you can easily point out the problem here, this is just a silly little example but it shows that all I am saying is that if the text box is blank, nothing will happen, otherwise if something is there then my app will do something I want it to.
So my question is; how do I tell my app to actually see if the path I have written in is valid and performs a particular task if the path is found to be invalid. Also, I would like to go one step further with this. Say for example I want my application to only work when a certain file type is written in the text box for the path (eg; C:\app\document.doc). I also want to be able to prevent the application from crashing when loading a fake or invalid .doc file (just incase someone tries to pass off a jpeg as a doc file or something.
Re: Starting a function after invalid path is found
Try this:
Code:
If Dir(txt.text, vbDirectory) = "" Then
Use a Common Dialog Control box, just like the ones you see in Windows.
Code:
Option Explicit
' cdlCFPrinterFonts &H2
' Save File Options
'&H2 - Forces a warning before overwriting a file
'&H8 - Stops default directory from changing
'&H200 - more than one file can be selected.
'&H1000 - This makes it so the file must exist.
'&H2000 - This warns the user before creating a new file.
Private Sub cmdOpen_Click()
' CancelError is True.
On Error GoTo ErrHandler
CommonDialog1.InitDir = App.Path
' Set Flags
CommonDialog1.Flags = cdlOFNAllowMultiselect Or cdlOFNLongNames
' Set filters.
CommonDialog1.Filter = "All Files (*.*)|*.*|Text" & _
"Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
' CommonDialog1.Filter = "AutoForm Files (*.doc) (*.rtf)|*.doc;*.rtf|All " & _
"Files (*.*)|*.*"
' Specify default filter.
CommonDialog1.FilterIndex = 2 ' Default to TEXT
' Display the Open dialog box.
CommonDialog1.ShowOpen
' Call the open file procedure.
' OpenFile (CommonDialog1.FileName)
Debug.Print CommonDialog1.FileName
Exit Sub
ErrHandler:
' User pressed Cancel button.
Exit Sub
End Sub
Private Sub cmdShowColor_Click()
' Set Cancel to True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Set the Flags property
CommonDialog1.Flags = cdlCFEffects Or cdlCFBoth
' Display the Font dialog box
CommonDialog1.ShowColor
rtb.BackColor = CommonDialog1.Color
Exit Sub
ErrHandler:
' User pressed the Cancel button
Exit Sub
End Sub
Private Sub cmdShowFont_Click()
' Set Cancel to True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Set the Flags property
CommonDialog1.Flags = cdlCFEffects Or cdlCFBoth ' cdlCFPrinterFonts
' Display the Font dialog box
CommonDialog1.ShowFont
If rtb.SelLength = 0 Then
rtb.SelStart = 0
rtb.SelLength = Len(rtb.SelRTF)
End If
rtb.SelFontName = CommonDialog1.FontName
rtb.SelFontSize = CommonDialog1.FontSize
rtb.SelBold = CommonDialog1.FontBold
rtb.SelItalic = CommonDialog1.FontItalic
rtb.SelUnderline = CommonDialog1.FontUnderline
rtb.SelStrikeThru = CommonDialog1.FontStrikethru
rtb.SelColor = CommonDialog1.Color
Exit Sub
ErrHandler:
' User pressed the Cancel button
Exit Sub
End Sub
Private Sub cmdSaveFile_Click()
Dim strFileName As String
Dim ans As Integer
CommonDialog1.Flags = &H2 ' Overwrite Flag
CommonDialog1.Filter = "RTF|*.rtf|Text|*.txt"
CommonDialog1.ShowSave
On Error GoTo SaveProblems
strFileName = CommonDialog1.FileName
If CommonDialog1.FilterIndex = 1 Then
CommonDialog1.DefaultExt = "rtf"
rtb.SaveFile strFileName
Else
CommonDialog1.DefaultExt = "txt"
rtb.SaveFile strFileName, rtfText
End If
Exit Sub
SaveProblems:
MsgBox "Can’t save the file, try again.", vbCritical
Exit Sub
End Sub
Private Sub Form_Load()
Label1.Caption = "Open File into RTB " & vbCrLf & _
"Save File from RTB" & vbCrLf & _
"Show Font" & vbCrLf & _
"Change selected text" & vbCrLf & _
" or all text." & vbCrLf & _
"Show Color" & vbCrLf & _
"Change BackColor of RTB"
End Sub
Sub SaveMultipleFiles()
Dim strOrigDir As String
Dim strNewDir As String
Dim varTemp As Variant
Dim lngIdx As Long
strNewDir = "D:\Temp\"
With CommonDialog1
.Flags = cdlOFNAllowMultiselect Or cdlOFNLongNames Or cdlOFNExplorer
.ShowSave
varTemp = Split(.FileName, vbNullChar)
End With
If IsArray(varTemp) Then
If UBound(varTemp) = 0 Then
FileCopy varTemp(lngIdx), strNewDir & Right$(varTemp(lngIdx), Len(varTemp(lngIdx)) - InStrRev(varTemp(lngIdx), "\"))
Else
strOrigDir = varTemp(0)
For lngIdx = LBound(varTemp) + 1 To UBound(varTemp)
FileCopy strOrigDir & "\" & varTemp(lngIdx), strNewDir & varTemp(lngIdx)
Next
End If
End If
End Sub
Re: Starting a function after invalid path is found
Or you could use the FileSystemObject;
Add a reference to Microsoft Scripting Runtime
Code:
Public Sub FindMyFolder(byval strFolderName as string)
dim fso As Scripting.FileSystemObject
Set fso = new Scripting.FileSystemObject
If Not fso.GetFolder(strFolderName) then
call DoSomethingWhenFolderIsNotThere
Else
Call DoSomethingWhenFolderIsThere
End If
Set fso = nothing
End Sub
Last edited by Twodogs; February 17th, 2008 at 08:26 PM.
Reason: Oops :)
Re: Starting a function after invalid path is found
Originally Posted by dglienna
Try this:
Code:
If Dir(txt.text, vbDirectory) = "" Then
Use a Common Dialog Control box, just like the ones you see in Windows.
Code:
Option Explicit
' cdlCFPrinterFonts &H2
' Save File Options
'&H2 - Forces a warning before overwriting a file
'&H8 - Stops default directory from changing
'&H200 - more than one file can be selected.
'&H1000 - This makes it so the file must exist.
'&H2000 - This warns the user before creating a new file.
Private Sub cmdOpen_Click()
' CancelError is True.
On Error GoTo ErrHandler
CommonDialog1.InitDir = App.Path
' Set Flags
CommonDialog1.Flags = cdlOFNAllowMultiselect Or cdlOFNLongNames
' Set filters.
CommonDialog1.Filter = "All Files (*.*)|*.*|Text" & _
"Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
' CommonDialog1.Filter = "AutoForm Files (*.doc) (*.rtf)|*.doc;*.rtf|All " & _
"Files (*.*)|*.*"
' Specify default filter.
CommonDialog1.FilterIndex = 2 ' Default to TEXT
' Display the Open dialog box.
CommonDialog1.ShowOpen
' Call the open file procedure.
' OpenFile (CommonDialog1.FileName)
Debug.Print CommonDialog1.FileName
Exit Sub
ErrHandler:
' User pressed Cancel button.
Exit Sub
End Sub
Private Sub cmdShowColor_Click()
' Set Cancel to True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Set the Flags property
CommonDialog1.Flags = cdlCFEffects Or cdlCFBoth
' Display the Font dialog box
CommonDialog1.ShowColor
rtb.BackColor = CommonDialog1.Color
Exit Sub
ErrHandler:
' User pressed the Cancel button
Exit Sub
End Sub
Private Sub cmdShowFont_Click()
' Set Cancel to True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Set the Flags property
CommonDialog1.Flags = cdlCFEffects Or cdlCFBoth ' cdlCFPrinterFonts
' Display the Font dialog box
CommonDialog1.ShowFont
If rtb.SelLength = 0 Then
rtb.SelStart = 0
rtb.SelLength = Len(rtb.SelRTF)
End If
rtb.SelFontName = CommonDialog1.FontName
rtb.SelFontSize = CommonDialog1.FontSize
rtb.SelBold = CommonDialog1.FontBold
rtb.SelItalic = CommonDialog1.FontItalic
rtb.SelUnderline = CommonDialog1.FontUnderline
rtb.SelStrikeThru = CommonDialog1.FontStrikethru
rtb.SelColor = CommonDialog1.Color
Exit Sub
ErrHandler:
' User pressed the Cancel button
Exit Sub
End Sub
Private Sub cmdSaveFile_Click()
Dim strFileName As String
Dim ans As Integer
CommonDialog1.Flags = &H2 ' Overwrite Flag
CommonDialog1.Filter = "RTF|*.rtf|Text|*.txt"
CommonDialog1.ShowSave
On Error GoTo SaveProblems
strFileName = CommonDialog1.FileName
If CommonDialog1.FilterIndex = 1 Then
CommonDialog1.DefaultExt = "rtf"
rtb.SaveFile strFileName
Else
CommonDialog1.DefaultExt = "txt"
rtb.SaveFile strFileName, rtfText
End If
Exit Sub
SaveProblems:
MsgBox "Can’t save the file, try again.", vbCritical
Exit Sub
End Sub
Private Sub Form_Load()
Label1.Caption = "Open File into RTB " & vbCrLf & _
"Save File from RTB" & vbCrLf & _
"Show Font" & vbCrLf & _
"Change selected text" & vbCrLf & _
" or all text." & vbCrLf & _
"Show Color" & vbCrLf & _
"Change BackColor of RTB"
End Sub
Sub SaveMultipleFiles()
Dim strOrigDir As String
Dim strNewDir As String
Dim varTemp As Variant
Dim lngIdx As Long
strNewDir = "D:\Temp\"
With CommonDialog1
.Flags = cdlOFNAllowMultiselect Or cdlOFNLongNames Or cdlOFNExplorer
.ShowSave
varTemp = Split(.FileName, vbNullChar)
End With
If IsArray(varTemp) Then
If UBound(varTemp) = 0 Then
FileCopy varTemp(lngIdx), strNewDir & Right$(varTemp(lngIdx), Len(varTemp(lngIdx)) - InStrRev(varTemp(lngIdx), "\"))
Else
strOrigDir = varTemp(0)
For lngIdx = LBound(varTemp) + 1 To UBound(varTemp)
FileCopy strOrigDir & "\" & varTemp(lngIdx), strNewDir & varTemp(lngIdx)
Next
End If
End If
End Sub
I would like to avoid using OCX files as they are very messy and cumbersome on an application they are assigned to.
Thanks for the help though. I will try out Twodoggs method and if for some reason that doesn't work for me I will use the Common Dialog example as an absolute final and last solution.
Re: Starting a function after invalid path is found
In TwoDogs code is a mistake.
It would be
Code:
'wrong If Not fso.GetFolder(strFolderName) then
If fso.GetFolder(strFolderName) Is Nothing then
call DoSomethingWhenFolderIsNotThere
Else
Call DoSomethingWhenFolderIsThere
End If
fso.Getfolder is no boolean, but returns a Folder object or Nothing if the folder is not there.
Last edited by WoF; February 18th, 2008 at 09:29 AM.
Re: Starting a function after invalid path is found
Originally Posted by Twodogs
This is what you get when writing code straight out of your memory during lunchtime... I feel so bad now....
You don't have to feel bad. You tried to write code right from your memory and that does not guarantee that it will be 100% right. You were able to provide some kind of pointer to the OP and that is what help means.
* The Best Reasons to Target Windows 8
Learn some of the best reasons why you should seriously consider bringing your Android mobile development expertise to bear on the Windows 8 platform.