Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Removing extensions from a FileListBox 2
- Thread starter Bubbler
- Start date
-
2
- #2
No. You could have a dummy listbox and read the files from the filelistbox into the listbox removing the extensions, or you could use the dir function(without filelistbox)...
Private Sub Command1_Click()
ListDir "c:\", "*.*"
End Sub
Private Sub ListDir(ThisPath As String, ThisPattern As String)
'get all files on this directory which match pattern
' "*.*" all files
' "*.txt" text files etc etc
On Error GoTo 1
Dim Thisfile As String
Dim char As String
If Right$(ThisPath, 1) <> "\" Then ThisPath = ThisPath + "\"
Thisfile = Dir$(ThisPath + ThisPattern, 0)
List1.Tag = ThisPath
Do While Thisfile <> ""
On Error Resume Next
char = InStrRev(Right(Thisfile, 5), "."
On Error GoTo 0
Select Case char
Case 1, 2, 3, 4
List1.AddItem Left(Thisfile, Len(Thisfile) - (5 - char + 1))
Case Else
'Unknown extension so add the file to list
List1.AddItem Thisfile
End Select
Thisfile = Dir$
Loop
Exit Sub
1 MsgBox "Drive not reading"
End Sub
Private Sub Command1_Click()
ListDir "c:\", "*.*"
End Sub
Private Sub ListDir(ThisPath As String, ThisPattern As String)
'get all files on this directory which match pattern
' "*.*" all files
' "*.txt" text files etc etc
On Error GoTo 1
Dim Thisfile As String
Dim char As String
If Right$(ThisPath, 1) <> "\" Then ThisPath = ThisPath + "\"
Thisfile = Dir$(ThisPath + ThisPattern, 0)
List1.Tag = ThisPath
Do While Thisfile <> ""
On Error Resume Next
char = InStrRev(Right(Thisfile, 5), "."
On Error GoTo 0
Select Case char
Case 1, 2, 3, 4
List1.AddItem Left(Thisfile, Len(Thisfile) - (5 - char + 1))
Case Else
'Unknown extension so add the file to list
List1.AddItem Thisfile
End Select
Thisfile = Dir$
Loop
Exit Sub
1 MsgBox "Drive not reading"
End Sub
LPlates,
I was just about to tell you that your line of code wasn't right, when I saw the little "Rev" tacked on the end of InStr. Thanks for letting me know about this function!
-E
I was just about to tell you that your line of code wasn't right, when I saw the little "Rev" tacked on the end of InStr. Thanks for letting me know about this function!
Code:
char = InStr[b]Rev[/b](Right(Thisfile, 5), ".")-E
- Thread starter
- #4
That seems viable LPlates but how do i make them shell execute? I was using a FileListBox to do it like this:
Private Declare Function ShellExecute yadda yadda yaddd....
And then in File1's Click Event
Dim ExPath
ExPath = File1.Path & "\" & File1.List(File1.ListIndex)
ShellExecute hWnd, "open", ExPath, vbNullString, vbNullString, SW_SHOWMAXIMIZED
Obviously I can't do List1.Path.... and so on
Private Declare Function ShellExecute yadda yadda yaddd....
And then in File1's Click Event
Dim ExPath
ExPath = File1.Path & "\" & File1.List(File1.ListIndex)
ShellExecute hWnd, "open", ExPath, vbNullString, vbNullString, SW_SHOWMAXIMIZED
Obviously I can't do List1.Path.... and so on
>Obviously I can't do List1.Path
I set the List1.Tag to = FilePath (see above)
Store the filenames in an array...
Dim arrFile() As String
In the ListDir sub add the bold text in the corresponding position's ...
List1.Tag = ThisPath
[bold]Dim x As Integer
ReDim arrFile(0)[/bold]
Do While Thisfile <> ""
[bold]ReDim Preserve arrFile(x)
arrFile(x) = Thisfile
x = x + 1[/bold]
On Error Resume Next
List1 Click...
Private Sub List1_Click()
Dim ExPath
ExPath = List1.Tag & arrFile(List1.ListIndex)
ShellExecute hWnd, "open", ExPath, vbNullString, vbNullString, SW_SHOWMAXIMIZED
End Sub
I set the List1.Tag to = FilePath (see above)
Store the filenames in an array...
Dim arrFile() As String
In the ListDir sub add the bold text in the corresponding position's ...
List1.Tag = ThisPath
[bold]Dim x As Integer
ReDim arrFile(0)[/bold]
Do While Thisfile <> ""
[bold]ReDim Preserve arrFile(x)
arrFile(x) = Thisfile
x = x + 1[/bold]
On Error Resume Next
List1 Click...
Private Sub List1_Click()
Dim ExPath
ExPath = List1.Tag & arrFile(List1.ListIndex)
ShellExecute hWnd, "open", ExPath, vbNullString, vbNullString, SW_SHOWMAXIMIZED
End Sub
- Thread starter
- #6
Man, I am all messed up, I am not sure what to do next here is what I have so far:
Code:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWMAXIMIZED = 3
Code:
Private Sub Command1_Click()
Code:
ListDir "C:\", "*.*"
Code:
End Sub
Code:
Private Sub ListDir(ThisPath As String, ThisPattern As String)
Code:
On Error GoTo 1
Code:
Dim Thisfile As String
Code:
Dim char As String
Code:
Dim arrFile() As String
Code:
If Right$(ThisPath, 1) <> "\" Then ThisPath = ThisPath + "\"
Code:
Thisfile = Dir$(ThisPath + ThisPattern, 0)
Code:
List1.Tag = FilePath
Code:
Do While Thisfile <> ""
Code:
On Error Resume Next
Code:
char = InStrRev(Right(Thisfile, 5), ".")
Code:
On Error GoTo 0
Code:
Select Case char
Code:
Case 1, 2, 3, 4
Code:
List1.AddItem Left(Thisfile, Len(Thisfile) - (5 - char + 1))
Code:
Case Else
Code:
List1.AddItem Thisfile
Code:
End Select
Code:
Thisfile = Dir$
Code:
Loop
Code:
Exit Sub
Code:
1 MsgBox "Drive not reading"
Code:
End Sub
Code:
Private Sub List1_Click()
Code:
Dim ExPath
Code:
ExPath = List1.Tag & arrFile(List1.ListIndex)
Code:
ShellExecute hwnd, "open", ExPath, vbNullString, vbNullString, SW_SHOWMAXIMIZED
Code:
End SubHere it is...
Option Explicit
Dim arrFile() As String
Const SW_SHOWNORMAL = 1
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
ListDir "c:\windows\desktop\", "*.*"
End Sub
Private Sub ListDir(ThisPath As String, ThisPattern As String)
'get all files on this directory which match pattern
' "*.*" all files
' "*.txt" text files etc etc
On Error GoTo 1
Dim Thisfile As String
Dim char As String
List1.Clear
If Right$(ThisPath, 1) <> "\" Then ThisPath = ThisPath + "\"
Thisfile = Dir$(ThisPath + ThisPattern, 0)
List1.Tag = ThisPath
Dim x As Integer
ReDim arrFile(0)
Do While Thisfile <> ""
ReDim Preserve arrFile(x)
arrFile(x) = Thisfile
x = x + 1
On Error Resume Next
char = InStrRev(Right(Thisfile, 5), "."
On Error GoTo 0
Select Case char
Case 1, 2, 3, 4
List1.AddItem Left(Thisfile, Len(Thisfile) - (5 - char + 1))
Case Else
'Unknown extension so add the file to list
List1.AddItem Thisfile
End Select
Thisfile = Dir$
Loop
Exit Sub
1 MsgBox "Drive not reading"
End Sub
Private Sub List1_DblClick()
Dim ExPath
ExPath = List1.Tag & arrFile(List1.ListIndex)
ShellExecute hwnd, "open", ExPath, vbNullString, vbNullString, SW_SHOWNORMAL
End Sub
Option Explicit
Dim arrFile() As String
Const SW_SHOWNORMAL = 1
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
ListDir "c:\windows\desktop\", "*.*"
End Sub
Private Sub ListDir(ThisPath As String, ThisPattern As String)
'get all files on this directory which match pattern
' "*.*" all files
' "*.txt" text files etc etc
On Error GoTo 1
Dim Thisfile As String
Dim char As String
List1.Clear
If Right$(ThisPath, 1) <> "\" Then ThisPath = ThisPath + "\"
Thisfile = Dir$(ThisPath + ThisPattern, 0)
List1.Tag = ThisPath
Dim x As Integer
ReDim arrFile(0)
Do While Thisfile <> ""
ReDim Preserve arrFile(x)
arrFile(x) = Thisfile
x = x + 1
On Error Resume Next
char = InStrRev(Right(Thisfile, 5), "."
On Error GoTo 0
Select Case char
Case 1, 2, 3, 4
List1.AddItem Left(Thisfile, Len(Thisfile) - (5 - char + 1))
Case Else
'Unknown extension so add the file to list
List1.AddItem Thisfile
End Select
Thisfile = Dir$
Loop
Exit Sub
1 MsgBox "Drive not reading"
End Sub
Private Sub List1_DblClick()
Dim ExPath
ExPath = List1.Tag & arrFile(List1.ListIndex)
ShellExecute hwnd, "open", ExPath, vbNullString, vbNullString, SW_SHOWNORMAL
End Sub
- Thread starter
- #8
- Status
Similar threads
- Locked
- Question
