ajliaks


Hi guys,

I am looking for a VBA Excel function which lets me change the name of a file without oppening it. (any file, not only office).

for example if I have the file "myDocument.doc" I want to call it "myNEWDocument.doc" without oppening it. If there is not such a function, what I will do is:

Opening the file

Saving the file with the new name

Killing the file with the original name.

In order to do this I need to get the extension of the file, but having difficulties because I am working both with Office 2003 and 2007 and the extension has 4 or 5 characters.

Any help will be appreciated,

Thanks in advance,

Aldo.





Re: VBA Excel - Getting file Extension

magicalclick


You can try using Files System Object. Make sure you reference "Microsoft Scripting Runtime"

http://msdn.microsoft.com/library/default.asp url=/library/en-us/script56/html/8b99eead-e2bd-45c6-9660-bbbfeec192f0.asp

I think VBA has function for your need, but I don't know how. Using this Files System Object is cool because I can use this in anything, even on HTML pages. So, this is like a one time learning thing that can be applied to everything. Best of all, I can open a text file with it.






Re: VBA Excel - Getting file Extension

ajliaks

Hi man,

I can not open the link. Do you have the right one

Can you give an example how to use Files System Object

Thanks,

Aldo.







Re: VBA Excel - Getting file Extension

magicalclick

Try this link. It seems like they took out the old MSDN.

http://msdn2.microsoft.com/en-us/library/hww8txat.aspx

You should use this function

http://msdn2.microsoft.com/en-us/library/2wcf3ba6.aspx

Sub MoveAFile(Drivespec)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile Drivespec, "c:\windows\desktop\"
End Sub

Good luck.




Re: VBA Excel - Getting file Extension

ajliaks

After learning, I have attached a couple of solutions using File System Object:

Option Explicit

Sub Testing_File_System_Object()
Dim myFileName, myFileType As String
Dim mySourceFolder, SourceFolderPath As String
Dim myDestFolder, DestFolderPath As String


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

myFileName = "myFileName"
myFileType = ".txt"

mySourceFolder = "mySourceFolder"
SourceFolderPath = "C:\"

myDestFolder = "myDestFolder"
DestFolderPath = "C:\"

Call CreateFolder(FolderName:=myDestFolder, FolderPath:=DestFolderPath)


Call CreateFile(FileType:=myFileType, FileName:=myFileName, FilePath:=DestFolderPath & "\" & myDestFolder, OverwriteExistingFile:=False)


Call CopyOrMoveFiles_ToOtherFolder(SourcePath:=SourceFolderPath, SourceFolderName:=mySourceFolder, DestPath:=DestFolderPath, DestFolderName:=myDestFolder, CopyOrMove:="Move")


Call GettingFileExtension(FilePathAndName:=SourceFolderPath & mySourceFolder )

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Function CreateFolder(Optional FolderName As Variant, Optional FolderPath As Variant)
Dim objFSO, objFolder
Dim Overwrite As Boolean

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set objFSO = CreateObject("Scripting.FileSystemObject")
Overwrite = objFSO.FolderExists(FolderPath & "\" & FolderName)

Select Case Overwrite
Case False: Set objFolder = objFSO.CreateFolder(FolderPath & "\" & FolderName)
Case Else
End Select
Set objFSO = Nothing: Set objFolder = Nothing
End Function

Function CreateFile(Optional FileType As Variant, Optional FileName As Variant _
, Optional FilePath As Variant, Optional OverwriteExistingFile As Variant)
Dim objFSO, objFile

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(FilePath & "\" & FileName & FileType, OverwriteExistingFile)

Set objFSO = Nothing: Set objFile = Nothing
End Function

Function CopyOrMoveFiles_ToOtherFolder(Optional SourcePath As Variant, Optional SourceFolderName As Variant _
, Optional DestPath As Variant, Optional DestFolderName As Variant _
, Optional CopyOrMove As Variant)
Dim objFSO, objFile, objSourceFolder
Dim Counter As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set objFSO = CreateObject("Scripting.FileSystemObject")

'Verify that the specified destination path exists, or create it:
Call CreateFolder(FolderName:=DestFolderName, FolderPath:=DestPath)

'Check Folder attributes - GetAttr():
' vbNormal 0 Normal.
' vbReadOnly 1 Read-only.
' vbHidden 2 Hidden.
' vbSystem 4 System file
' vbDirectory 16 Directory or folder.
' vbArchive 32 File has changed since last backup
Select Case GetAttr(DestPath & "\" & DestFolderName)
Case 0, 1, 2, 16: 'Copy or Move Files
Set objSourceFolder = objFSO.GetFolder(SourcePath & "\" & SourceFolderName)
If Not objSourceFolder.Files.Count > 0 Then GoTo NoFiles
Counter = 0 'Copied files counting

For Each objFile In objSourceFolder.Files
On Error GoTo ErrHandler
Select Case CopyOrMove
Case "Copy": objFile.Copy DestPath & "\" & DestFolderName & "\" & objFile.Name: Counter = Counter + 1
Case "Move": objFile.Move DestPath & "\" & DestFolderName & "\" & objFile.Name: Counter = Counter + 1
Case Else: 'CopyOrMove
End Select
Next objFile
Case Else: 'GetAttr
End Select

Set objFSO = Nothing: Set objSourceFolder = Nothing: Set objFile = Nothing
Exit Function

'Error handling
NoFiles: MsgBox "No files into Folder"
ErrHandler: MsgBox "ErrHandler: " & Err.Number & Err.Description & vbCrLf & vbCrLf & vbCrLf & "Please verify that all files in the folder are not currently open," & "and the source directory is available"
Err.Clear 'clear the error
End Function

Function GettingFileExtension(Optional FilePathAndName As Variant) As Variant
Dim objFSO, objFile
Dim FileExists As Boolean

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set objFSO = CreateObject("Scripting.FileSystemObject")
FileExists = objFSO.FileExists(FilePathAndName)
Select Case FileExists
Case True: GettingFileExtension = objFSO.GetExtensionName(FilePathAndName)
Case False: GoTo ErrHandler
End Select
Set objFSO = Nothing: Set objFile = Nothing
Exit Function

ErrHandler:
MsgBox "The file you are looking for does not exists", vbMsgBoxRight + vbMsgBoxRtlReading + vbExclamation, "Alert"

End Function

Aldo.