Rename .txt Files VBA

[wallieh]

Hi all,

I have a macro that should change the name for some .txt files that are created automatically. The issue I have is that the macro shows an error at the end from OldName to NewName

My .txt files are generated automatically:

Text_1.txt
Text_2.txt
Text_3.txt...
...
Text_58.txt
Text_59.txt

Each file contains a code, for example


Text_1.txt
----------------------------------------------------------------------------
From: 09/12/14 My Report Summary
To: 09/12/14
Shift: 90 5p-8p

Doc: 5015 Acer
-----------------------------------------------------------------------------

For every doc number select a case and rename it, but if the .txt file does not have any code the macro stops working.

Could you please assist me on this? THIS IS URGENT!!!!

below you can find the macro.

Thanks.

Willy

Sub RenameFiles()

Dim objFso As Object
Dim objFiles As Object
Dim objFile As Object

sPath = "C:\My report\Text files"


Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFiles = objFso.getfolder(sPath).Files


Application.StatusBar = "Renaming files..."
Application.ScreenUpdating = False


I = 1
For Each objFile In objFiles
If UCase(Right(objFile.Path, (Len(objFile.Path) - InStrRev(objFile.Path, ".")))) = "TXT" Then

Workbooks.OpenText Filename:=objFile.Path, Origin:= _
437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
Array(39, 1), Array(50, 1)), TrailingMinusNumbers:=True

MyName = Left(Range("A8"), 8)

shift = Trim(Mid(Range("A5"), 8, 2))

If shift = "0" Then
fnameext = "_AD"
Else
fnameext = ""
End If

Select Case MyName

Case "Doc: 2002"
Fname = "Document_1" & fnameext & ".txt"

Case "Doc: 6000"
Fname = "Document_2" & fnameext & ".txt"

Case "Doc: 1002"
Fname = "Document_3" & fnameext & ".txt"

Case "Doc: 4007"
Fname = "Document_4" & fnameext & ".txt"

Case "Doc: 1012"
Fname = "Document_5" & fnameext & ".txt"

Case "Doc: 2013"
Fname = "Document_6" & fnameext & ".txt"

Case "Doc: 2015"
Fname = "Document_7" & fnameext & ".txt"

Case "Doc: 4002"
Fname = "Document_8" & fnameext & ".txt"

Case "Doc: 5002"
Fname = "Document_9" & fnameext & ".txt"

Case "Doc: 4001"
Fname = "Document_10" & fnameext & ".txt"

Case "Doc: 3013"
Fname = "Document_11" & fnameext & ".txt"

Case "Doc: 6002"
Fname = "Document_12" & fnameext & ".txt"

Case "Doc: 5015"
Fname = "Document_13" & fnameext & ".txt"

Case "Doc: 2025"
Fname = "Document_14" & fnameext & ".txt"

Case "Doc: 1008"
Fname = "Document_15" & fnameext & ".txt"

Case "Doc: 2012"
Fname = "Document_16" & fnameext & ".txt"

Case "Doc: 5013"
Fname = "Document_17" & fnameext & ".txt"

Case "Doc: 2051"
Fname = "Document_18" & fnameext & ".txt"

Case "Doc: 2050"
Fname = "Document_19" & fnameext & ".txt"

Case "Doc: 2054"
Fname = "Document_20" & fnameext & ".txt"

Case "Doc: 3008"
Fname = "Document_21" & fnameext & ".txt"

Case "Doc: 7002"
Fname = "Document_22" & fnameext & ".txt"

Case "Doc: 1009"
Fname = "Document_23" & fnameext & ".txt"

Case "Doc: 4015"
Fname = "Document_24" & fnameext & ".txt"

Case "Doc: 2014"
Fname = "Document_25" & fnameext & ".txt"

Case "Doc: 3004"
Fname = "Document_26" & fnameext & ".txt"

Case "Doc: 1075"
Fname = "Document_27" & fnameext & ".txt"

Case "Doc: 1076"
Fname = "Document_28" & fnameext & ".txt"

Case "Doc: 1080"
Fname = "Document_29" & fnameext & ".txt"

Case Else
Fname = "Unknown Doc " & I & ".txt"

End Select

ActiveWorkbook.Close

OldName = objFile.Path
NewName = "c:My report\Text files\" & Fname

Name OldName As NewName


End If
I = I + 1
Next objFile

Application.StatusBar = False
Application.ScreenUpdating = True

End Sub

[alansidman]

Code Tags Added
Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found at http://www.excelforum.com/forum-rule...rum-rules.html



(Because you are new to the forum, I have added them for you today. Please take a few minutes to read all Forum Rules and comply in the future.)

[Ed_Collins]

If the macro crashes / stops working with text files that have no code/data in them, then can't you just put a single IF statement in there, checking first to see if there IS data inside? If there isn't, then just continue on and read the next file.

If data_inside_current_text_file = true then
<execute your code here>
else
<do nothing>
end if

Maybe I'm missing something.

[wallieh]

Thanks for your reply, Ed. I think I did something simpler or at least something I could understand because I'm kinda new in programming with VBA and the code was not mine.

This code below works just perfect.

I appreciate

Sub RenameFiles()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FolderPath As String, path, newpath As String, count, x As Integer
FolderPath = "C:\My report\Text Files"

path = FolderPath & "\*.txt"

Filename = Dir(path)

Do While Filename <> ""
count = count + 1
Filename = Dir()
Loop

For x = 1 To count
Application.StatusBar = "Renaiming " & x & " of " & count & " files..."

newpath = FolderPath & "\Text_" & x & ".txt"

i = 1
Workbooks.OpenText Filename:=newpath, Origin:= _
437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
Array(39, 1), Array(50, 1)), TrailingMinusNumbers:=True

MyName = Left(Range("A8"), 8)

shift = Trim(Mid(Range("A5"), 8, 2))

If shift = "0" Then
fnameext = "_AD"
Else
fnameext = ""
End If

Select Case MyName

Case "Doc: 2002"
Fname = "Document_1" & fnameext & ".txt"

Case "Doc: 6000"
Fname = "Document_2" & fnameext & ".txt"

Case "Doc: 1002"
Fname = "Document_3" & fnameext & ".txt"

Case "Doc: 4007"
Fname = "Document_4" & fnameext & ".txt"

Case "Doc: 1012"
Fname = "Document_5" & fnameext & ".txt"

Case "Doc: 2013"
Fname = "Document_6" & fnameext & ".txt"

Case "Doc: 2015"
Fname = "Document_7" & fnameext & ".txt"

Case "Doc: 4002"
Fname = "Document_8" & fnameext & ".txt"

Case "Doc: 5002"
Fname = "Document_9" & fnameext & ".txt"

Case "Doc: 4001"
Fname = "Document_10" & fnameext & ".txt"

Case "Doc: 3013"
Fname = "Document_11" & fnameext & ".txt"

Case "Doc: 6002"
Fname = "Document_12" & fnameext & ".txt"

Case "Doc: 5015"
Fname = "Document_13" & fnameext & ".txt"

Case "Doc: 2025"
Fname = "Document_14" & fnameext & ".txt"

Case "Doc: 1008"
Fname = "Document_15" & fnameext & ".txt"

Case "Doc: 2012"
Fname = "Document_16" & fnameext & ".txt"

Case "Doc: 5013"
Fname = "Document_17" & fnameext & ".txt"

Case "Doc: 2051"
Fname = "Document_18" & fnameext & ".txt"

Case "Doc: 2050"
Fname = "Document_19" & fnameext & ".txt"

Case "Doc: 2054"
Fname = "Document_20" & fnameext & ".txt"

Case "Doc: 3008"
Fname = "Document_21" & fnameext & ".txt"

Case "Doc: 7002"
Fname = "Document_22" & fnameext & ".txt"

Case "Doc: 1009"
Fname = "Document_23" & fnameext & ".txt"

Case "Doc: 4015"
Fname = "Document_24" & fnameext & ".txt"

Case "Doc: 2014"
Fname = "Document_25" & fnameext & ".txt"

Case "Doc: 3004"
Fname = "Document_26" & fnameext & ".txt"

Case "Doc: 1075"
Fname = "Document_27" & fnameext & ".txt"

Case "Doc: 1076"
Fname = "Document_28" & fnameext & ".txt"

Case "Doc: 1080"
Fname = "Document_29" & fnameext & ".txt"

Case Else
Fname = "Unknown Doc " & I & ".txt"
i = i + 1


End Select
savepath = FolderPath & "\" & Fname
ActiveWorkbook.SaveAs savepath
ActiveWorkbook.Close False

Next x

For y = 1 To count

Kill "C:\My report\Text Files\Text_" & y & ".txt"


Next y

Application.ScreenUpdating = True

End Sub