• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 298
  • Last Modified:

Open File and Save As

Advised to open new case.

I have several text files in a folder that I want to open automatically insert the snippet code attached for ...1.txt, then do the same thing for ...2.txt, and so on, then save to a different folder.  I've attached the snippet which I created from running a macro, I just don't know how to make it do it for each of the files, not just one.
Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\'SZYYNR SOIUF A0000A MASSE.K001'" _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(4, 1), Array(10, 1), Array(23, 1), Array(30, 1), Array(32, 1), Array(44, _
        1), Array(85, 1), Array(87, 1), Array(109, 1), Array(122, 1), Array(130, 1), Array(170, 1), _
        Array(199, 1)), TrailingMinusNumbers:=True
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:H").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "ORDER NO"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "MODEL"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "EVENT"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "RTPWDATE"
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\'SZYYNR SOIUF A0000A MASSE.K001'" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

Open in new window

-SZYYNR-SOIUF-A0000A-MASSE1.txt
-SZYYNR-SOIUF-A0000A-MASSE2.txt
0
mato01
Asked:
mato01
  • 8
  • 7
1 Solution
 
SimonCommented:
Are you sure you want to insert the code snippet into each one? Wouldn't it be better to just run the code from a master workbook?
 You'd just have to open each file in turn (it automatically becomes the activeworkbook).
0
 
KnutsonBMCommented:
See if this works for you

Sub OpenSave()

folderspec = "C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files

For Each f1 In fc

If Right(f1.Name, 4) = ".txt" Then

Workbooks.OpenText Filename:= _
        f1 _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(4, 1), Array(10, 1), Array(23, 1), Array(30, 1), Array(32, 1), Array(44, _
        1), Array(85, 1), Array(87, 1), Array(109, 1), Array(122, 1), Array(130, 1), Array(170, 1), _
        Array(199, 1)), TrailingMinusNumbers:=True
        Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:H").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "ORDER NO"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "MODEL"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "EVENT"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "RTPWDATE"
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:= _
        f1 _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
       
        Else
        End If
       
Next f1
 
End Sub
0
 
KnutsonBMCommented:
Screwed up a line

folderspec = "C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\

should be

folderspec = "C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\"
0
Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

 
mato01Author Commented:
When I ran the script nothing happened????  Can you send me example?
0
 
mato01Author Commented:
Okay. The script works; however, it does not save it to a different folder or as an xls file.  It saves as a txt file.

After the script has run, I need to have the file save as .XLS files to the below folder

"C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\FINISHED\
0
 
mato01Author Commented:
Okay. The script works; however, it does not save it to a different folder or as an xls file.  It saves as a txt file.

After the script has run, I need to have the file save as .XLS files to the below folder

"C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\FINISHED\File1.xls
Okay. The script works; however, it does not save it to a different folder or as an xls file.  It saves as a txt file.

After the script has run, I need to have the files save as .XLS files to the below folder


So  That
"C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\File1.txt becomes
"C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\FINISHED\File1.xls

"C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\File2.txt becomes
"C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\FINISHED\File2xls

and so forth
0
 
KnutsonBMCommented:
Sub OpenSave()

folderspec = "C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\"
FinishedFolder = "C:\Documents and Settings\szyynr\My Documents\Attachmate\POM Files\FINISHED\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files

For Each f1 In fc

If Right(f1.Name, 4) = ".txt" Then

Workbooks.OpenText Filename:= _
        f1 _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(4, 1), Array(10, 1), Array(23, 1), Array(30, 1), Array(32, 1), Array(44, _
        1), Array(85, 1), Array(87, 1), Array(109, 1), Array(122, 1), Array(130, 1), Array(170, 1), _
        Array(199, 1)), TrailingMinusNumbers:=True
        Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:H").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "ORDER NO"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "MODEL"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "EVENT"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "RTPWDATE"
    Range("A1").Select
     
    ActiveWorkbook.SaveCopyAs (FinishedFolder & ActiveWorkbook.Name)
       
        Else
        End If
       
Next f1
 
End Sub
0
 
mato01Author Commented:
This saves the files to a new folder; however, they are still txt files.  I would like to be able to save as an excel formatted file.
0
 
KnutsonBMCommented:
Sub OpenSave()

folderspec = "C:\Documents and Settings\hk468c\Desktop\New Folder\"
FinishedFolder = "C:\Documents and Settings\hk468c\Desktop\New Folder\FINISHED\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files

For Each f1 In fc

If Right(f1.Name, 4) = ".txt" Then

Workbooks.OpenText Filename:= _
        f1 _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(4, 1), Array(10, 1), Array(23, 1), Array(30, 1), Array(32, 1), Array(44, _
        1), Array(85, 1), Array(87, 1), Array(109, 1), Array(122, 1), Array(130, 1), Array(170, 1), _
        Array(199, 1)), TrailingMinusNumbers:=True
        Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:H").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "ORDER NO"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "MODEL"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "EVENT"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "RTPWDATE"
    Range("A1").Select
     
    ActiveWorkbook.SaveCopyAs (Left((FinishedFolder & ActiveWorkbook.Name), Len(FinishedFolder & ActiveWorkbook.Name) - 3) & "xls")
       
        Else
        End If
       
Next f1
 
End Sub



Sorry taht i didnt see that even though you posted it like 4 times, this should do the trick though!

-Brandon
0
 
KnutsonBMCommented:
doh i posted my test code up there, you will have to replace the folderspec and FinishedFolder with your file paths, sorry
0
 
mato01Author Commented:
Almost works.  However, it still saves as a text file with a .xls extension, not as a .xls file.  See files attached.

Attachment 1 is what the results of the macro.

Attachment 2 is what I'm actually  lookoing for.
Book-0G.xls
Book-0G---FINISHED.xls
0
 
KnutsonBMCommented:
ActiveWorkbook.SaveAs Filename:= _
        (Left((FinishedFolder & ActiveWorkbook.Name), Len(FinishedFolder & ActiveWorkbook.Name) - 3) & "xls")
, _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

try this
0
 
mato01Author Commented:
THis part turned RED (Compile error: Syntax error).  Am I missing something?

, _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
0
 
mato01Author Commented:
Ignore the comment after this.  I just needed to lose some space.  It works exactly like I wanted it to.

Thanks so much for your help, and definitely for your patience.

0
 
KnutsonBMCommented:
no, copy and paste problem on my part, sorry
[code]
ActiveWorkbook.SaveAs FileName:= _
        (Left((FinishedFolder & ActiveWorkbook.Name), Len(FinishedFolder & ActiveWorkbook.Name) - 3) & "xls"), _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
[\code]
0
 
KnutsonBMCommented:
thanks for the points and grade!
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 8
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now