?
Solved

function to remove file extensions

Posted on 2003-11-18
12
Medium Priority
?
1,234 Views
Last Modified: 2010-04-17
I need advice on where to start on making a program in vb that will auto take off file extensions. You see I need to point it at a specified directory and have it take all the file extensions off the files. I have tif files that are named like this 01000001.001.tiff all of them have eight then three then the file extension. The interfacing program doesn’t like the file extensions so I have to manually take each one off as they get uploaded to us. I’m trying to make a little vb program to do this for me. I just can’t see it, I know it should be easy and I have went over my vb books and can not find anything useful there “for this”. So what I'm looking for is a simple example function to do something like this. If there is a dos cammand i can use. That would work :-)
0
Comment
Question by:Scan_25
  • 3
  • 3
  • 3
  • +2
12 Comments
 
LVL 4

Expert Comment

by:1mak
ID: 9770929
is DOS:

rename *.tif *.

basically renames all files that end in ".tif" to have no extension...
0
 
LVL 4

Expert Comment

by:1mak
ID: 9770930
is DOS:

rename *.tif *.

basically renames all files that end in ".tif" to have no extension...
0
 
LVL 4

Expert Comment

by:1mak
ID: 9770937
(sorry for the double post? not sure why it happened?)
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 43

Expert Comment

by:TimCottee
ID: 9770949
Hi Scan_25,

This is quite simple:

Dim strFile As String
strFile = Dir("c:\myfolder\*.tif")
Do While strFile <> ""
  Name strFile, Left(strFile,Len(strFile) - 1)
  strFile = Dir()
Loop

Tim Cottee MCSD, MCDBA, CPIM
Brainbench MVP for Visual Basic
http://www.brainbench.com
0
 
LVL 48

Expert Comment

by:Mikal613
ID: 9771000

Private Sub Command1_Click()
      Text1.Text = GetFileNAme(Text1.Text)
End Sub

Private Function GetFileNAme(Str As String) As String
        GetFileNAme = Left(Str, InStrRev(Text1.Text, ".") - 1)
End Functio
0
 
LVL 7

Accepted Solution

by:
wsteegmans earned 375 total points
ID: 9771452
I should instead of renaming, copying them to another folder ... If everything is OK, you can delete the sourcefiles.

So, your sourcefolder are all the new files (with extensions). Your destinationfolder is the folder where your application will look for the files, without extension ...

The function DelFileExt removes your extension(s). More specific, it removes one or more, or all extensions of your file.
For example this file:

aaa.bbb.ccc.ddd.eee

It has 4 extensions (bbb, ccc, ddd and eee). This function gives these results for the file:
DelFileExt("aaa.bbb.ccc.ddd.eee") -> aaa                           ' all extension are removed
DelFileExt("aaa.bbb.ccc.ddd.eee", 1) -> aaa.bbb.ccc.ddd     ' just one extension is removed
DelFileExt("aaa.bbb.ccc.ddd.eee", 2) -> aaa.bbb.ccc           ' two extensions are removed
...

The code (also included the copy method)

Option Compare Database
Option Explicit

Sub CopyFilesWithoutExt(SourceDir As String, DestinationDir)

    Dim strNewFileName As String

    Dim fso As Scripting.FileSystemObject
    Dim oDir As Scripting.Folder
    Dim oFile As Scripting.File
   
    Set fso = New Scripting.FileSystemObject
    Set oDir = fso.GetFolder(SourceDir)
   
    For Each oFile In oDir.Files
        strNewFileName = DelFileExt(oFile.Name)
        oFile.Copy DestinationDir & "\" & strNewFileName
    Next

End Sub

Function DelFileExt(FileName As String, Optional ExtensionCount As Integer = -1) As String

    Dim strResult As String
    Dim intPos As Integer
   
    strResult = FileName
   
    intPos = InStrRev(FileName, ".")
    If (intPos > 0) And ExtensionCount <> 0 Then
        strResult = Left(FileName, intPos - 1)
' - - - If you want all the file-extension removed, so all the [.]
' - - - Call your function recursively ...
        strResult = DelFileExt(strResult, ExtensionCount - 1)
    End If
   
    DelFileExt = strResult

End Function

Sub Test()

    CopyFilesWithoutExt "c:\temp\tempsource", "c:\temp\tempdestination"

End Sub
0
 

Author Comment

by:Scan_25
ID: 9771566
All of your answers are great you guys a really great I don&#8217;t know if I can split points but wsteegmans gave me the most complete answer so I think I should give them to him are there any objections? Going ones!
I will do this in the next ten minutes if you other guys with the other great answers don&#8217;t mind.
0
 
LVL 43

Expert Comment

by:TimCottee
ID: 9771631
My only complaint with that solution is that it uses the FileSystemObject. This is generally a *BAD* thing! FSO is designed for VBScript where there are no alternatives. With VB you have the native file functions and the opportunity to use API calls. FSO cannot be guaranteed to be available as it is installed by Internet Explorer and can be disabled by a system administrator. Relying on the FSO to provide file-level access is not recommended.
0
 

Author Comment

by:Scan_25
ID: 9771731
TimCottee,
 Can you explain how wsteegmans example can be achieved without using FSO?
0
 
LVL 7

Expert Comment

by:wsteegmans
ID: 9771733
I can follow the comment of TimCottee ... (a bit)

There are indeed several disadvantages to the FSO. It works for example only with text files. To manipulate binary files, you must use pointers to an address in memory, or byte arrays, which are not supported by the object.

When you read or write a large amount of content, the information stored in the buffer may create a big memory hit. Finally, you cannot manage permissions or file and folder attributes.

But, the big advantage is that it's very easy to work with (for example to create structured Example Code ;-))
It is indeed not guaranteed that it's available on every system, but in the year 2003, this number will be very small.

I use it always to browse through folders, or to copy/move ... without any problem.
0
 
LVL 43

Expert Comment

by:TimCottee
ID: 9772178
Dim strFile As String
strFile = Dir("c:\myfolder\*.tif")
Do While strFile <> ""
  FileCopy strFile, "c:\MyNewFolder\" & Left(strFile,Len(strFile) - 1)
  strFile = Dir()
Loop

Is all that is required to create the copies:

Dim strFile As String
strFile = Dir("c:\myfolder\*.tif")
Do While strFile <> ""
  Kill strFile
  strFile = Dir()
Loop

To delete the originals

Dim strFile As String
strFile = Dir("c:\mynewfolder\*.tif")
Do While strFile <> ""
  FileCopy strFile, "c:\MyFolder\" & Left(strFile,Len(strFile) - 1)
  strFile = Dir()
Loop

To move the renamed ones back again
0
 

Author Comment

by:Scan_25
ID: 9772413
Ok, I just ran in to a little more trouble. I&#8217;m going to accept wsteegmans answer but I going to post a new question that is related to this one for further support. TimCottee, if you have time and can answer it award you some extra points from this question.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Make the most of your online learning experience.
This article will show how Aten was able to supply easy management and control for Artear's video walls and wide range display configurations of their newsroom.
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question