|
run time error 53
I am using a macro to open up unknown files from one folder, put them
in another and change the name. what happenes is when the folder runs out of files it stops the macro mid point. I need to get past this error with out a msg box or any stoppage. Do ChDir "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT\" & tmp.Sheets(1).Cells(Count, 1).Value) On Error Resume Next f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".txt" sName = Dir() Loop s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".dat" sName = Dir() Loop Please help |
run time error 53
Exactly where in the code does the code stop? I see that you have On Error
Resume Next that I assume is to cope with following line of code f2.Move ("C:\Documents .....etc. if it is unable to perform the move. If using the On Error to overcome a problem in lieu of testing for a condition because testing is not appropriate or whatever, you should insert On Error Goto 0 after the line of code otherwise all future errors are ignored and it makes it difficult to ascertain exactly what is failing. -- Regards, OssieMac " wrote: I am using a macro to open up unknown files from one folder, put them in another and change the name. what happenes is when the folder runs out of files it stops the macro mid point. I need to get past this error with out a msg box or any stoppage. Do ChDir "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT\" & tmp.Sheets(1).Cells(Count, 1).Value) On Error Resume Next f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".txt" sName = Dir() Loop s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".dat" sName = Dir() Loop Please help |
run time error 53
Not sure where you are getting the error but you could precede the particular
snippet with an If statement to exclude empty folders: eample: If Not fc Is Nothing Then 'your code to extract the file data End If That way, if there is no file, it will bypass the search. " wrote: I am using a macro to open up unknown files from one folder, put them in another and change the name. what happenes is when the folder runs out of files it stops the macro mid point. I need to get past this error with out a msg box or any stoppage. Do ChDir "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT\" & tmp.Sheets(1).Cells(Count, 1).Value) On Error Resume Next f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".txt" sName = Dir() Loop s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".dat" sName = Dir() Loop Please help |
run time error 53
On Aug 17, 9:34*pm, OssieMac
wrote: Exactly where in the code does the code stop? I see that you have On Error Resume Next that I assume is to cope with following line of code f2.Move ("C:\Documents .....etc. if it is unable to perform the move. If using the On Error to overcome a problem in lieu of testing for a condition because testing is not appropriate or whatever, you should insert On Error Goto 0 after the line of code otherwise all future errors are ignored and it makes it difficult to ascertain exactly what is failing. -- Regards, OssieMac " wrote: I am using a macro to open up unknown files from one folder, put them in another and change the name. *what happenes is when the folder runs out of files it stops the macro mid point. *I need to get past this error with out a msg box or any stoppage. Do ChDir "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") * * Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT") * * Set tmp = Workbooks.Add * * Set myfiles = f.Files * * counter = 1 * * For Each fc In myfiles * * * * tmp.Sheets(1).Cells(counter, 1).Value = fc.Name * * * * tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified * * * * counter = counter + 1 * * Next * * tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit * * tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select * * tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select * * Set sortrange = Selection * * For Count = 1 To 1 * * * * Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop <------------------------- \Data log trending Version 2.0\Data log files (by machine)\P124\TXT\" & tmp.Sheets(1).Cells(Count, 1).Value) -------------------------------------------------------------------------------------------------------------------------- This is where the code stops If I put on error goto 0 or on error resume next it doesn't effect the macro it still ends on error |
run time error 53
Do
ChDir "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT \" <------------------------------------- & tmp.Sheets(1).Cells(Count, 1).Value) __________________________________________________ _____________________________________ This is where I get the error |
run time error 53
JLGWhiz
I tried what you suggested but I just can't seem to get it to work....I have no idea where to put it....... |
run time error 53
Looking at your original posting, it seems you have the On Error statement in
the wrong place. I think it would work better like this. On Error Resume Next Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT\" & tmp.Sheets(1).Cells(Count, 1).Value) On Error GoTo 0 " wrote: JLGWhiz I tried what you suggested but I just can't seem to get it to work....I have no idea where to put it....... |
run time error 53
maybe you could adapt something like this, to determine the files to act on.
then just use lbound and ubound on the arrays. paste this code in a new module. in the vb editor, click debug then add watch. in the expression box enter txtfilestoprocess, click ok. do the same for datfilestoprocess. then set a breakpoint on the last loop statement. run the code when it stops, click view and then watch window. expand by clicking the + sign and see if your filenames are listed correctly. Sub test() Dim fpath As String Dim fname As String Dim fName2 As String Dim y As Long Dim z As Long Dim datFilesToProcess() As Variant Dim txtFilesToProcess() As Variant fpath = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\" fname = Dir(fpath & "*.dat") ' determine file to open Do While fname "" ReDim Preserve datFilesToProcess(0 To z) datFilesToProcess(z) = fname z = z + 1 fname = Dir() Loop fName2 = Dir(fpath & "*.txt") ' determine file to open Do While fName2 "" ReDim Preserve txtFilesToProcess(0 To y) txtFilesToProcess(y) = fName2 y = y + 1 fName2 = Dir() Loop End Sub -- Gary wrote in message ... I am using a macro to open up unknown files from one folder, put them in another and change the name. what happenes is when the folder runs out of files it stops the macro mid point. I need to get past this error with out a msg box or any stoppage. Do ChDir "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT\" & tmp.Sheets(1).Cells(Count, 1).Value) On Error Resume Next f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".txt" sName = Dir() Loop s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".dat" sName = Dir() Loop Please help |
run time error 53
Couple of things to try but first avoid using Count as a variable because it
is a reserved word. Could even be your main problem. Insert the following line of code before the problem code and then check what filename is being extracted from the worksheet and at what address it is attempting to find it. On Error Goto errorHandler at the bottom of the sub just before end sub insert the following Exit Sub 'Prevents this code running unless error sends it here errorHandler: MsgBox "Filename is " & tmp.Sheets(1).Cells(Count, 1).Value MsgBox Sheets(1).Cells(lngCount, 1).Address End Sub If there is no value because you have gone past the end of the data in the worksheet then use If / then / else / end if and test for tmp.Sheets(1).Cells(Count, 1).Value = "" (no value) and handle it from there. -- Regards, OssieMac " wrote: Do ChDir "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT \" <------------------------------------- & tmp.Sheets(1).Cells(Count, 1).Value) __________________________________________________ _____________________________________ This is where I get the error |
run time error 53
Am I correct in assuming that where you have For Count = 1 to 1 that you have
substituted this when trying to test your code and it should actually be as follows For Count = 1 to Counter If so then edit the following code as per the comments because with your method Count will finish up 1 greater than the number of files because it gets 1 added to it after being used in the last valid loop. The following method only adds 1 for each valid loop. counter = 0 'Initialize to zero instead of 1 For Each fc In myfiles counter = counter + 1 'set counter before using its value tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified 'counter = counter + 1 'Remove this line Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To Counter -- Regards, OssieMac |
run time error 53
Here is my entire code......
When I get the error I just want it to end the loop What I am trying to do (I know just enough about VBA to be dangerous) Is grab a TXT file out of one folder and put it in another (sorting by date) then the same to a DAT file. The are renamed and I then put them into a spread sheet, pull all the data out that I need and then loop through the folders until they are all gone. I have the counter because in the first verison of this spread sheet I was opening 5 files at a time....the down side of that is that I need mutiples of five and it doesn't always work out that way. I modified the counter so it would work and didn't want to mess with the code if I didn't have to. When I tried the error handler is just took me out of the macro even if I had files in the folder... WHen I tried the On error resume next/on error go to 0 it would get to the next bunch of code where it needed a file (and I don't have any left) and it owuld give me an error I just need this code to end with out error so once all the files are gone I can either add to this macro or make it start another macro. I hope this is making some sence.... no idea what I am doing so please help!!!! __________________________________________________ ______________________________________________ Sub Get_data_P124() ' ' Macro1 Macro ' Macro recorded 8/16/2008 by stephen smith Do ChDir "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\TXT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT") Set tmp = Workbooks.Add Set myfiles = f.Files counter = 1 For Each fc In myfiles tmp.Sheets(1).Cells(counter, 1).Value = fc.Name tmp.Sheets(1).Cells(counter, 2).Value = fc.datelastmodified counter = counter + 1 Next tmp.Sheets(1).Columns("B:B").EntireColumn.AutoFit tmp.Sheets(1).Range(Selection, Selection.End(xlToRight)).Select tmp.Sheets(1).Range(Selection, Selection.End(xlDown)).Select Set sortrange = Selection For Count = 1 To 1 Set f2 = fso.GetFile("C:\Documents and Settings\Owner\Desktop \Data log trending Version 2.0\Data log files (by machine)\P124\DAT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files \" & tmp.Sheets(1).Cells(Count, 1).Value) Next Count tmp.Close False Set tmp = Nothing s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".txt" sName = Dir() Loop s1 = "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files\" sName = Dir(s1 & "*.*") i = 0 Do While sName < "" i = i + 1 Name s1 & sName As s1 & i & ".dat" sName = Dir() Loop Workbooks.OpenText Filename:= _ "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files\1.txt" _ , Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _ :=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:= _ False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array _ (1, 1), Array(2, 1), Array(3, 1)) Cells.Select Selection.Copy Windows("code.xls").Activate Sheets("sheet6").Select Range("A1").Select ActiveSheet.Paste Workbooks("1.txt").Activate Range("A1").Select Application.CutCopyMode = False ActiveWindow.Close Workbooks.OpenText Filename:= _ "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files\1.dat", _ Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1) Cells.Select Selection.Copy Windows("code.xls").Activate Sheets("sheet4").Select Range("A1").Select ActiveSheet.Paste Workbooks("1.dat").Activate Range("A1").Select Application.CutCopyMode = False ActiveWindow.Close Workbooks("code.xls").Activate Sheets("Sheet6").Activate Rows("2:3000").Select Selection.Copy Sheets("Sheet1").Select Range("A1").Select ActiveSheet.Paste Columns("B:B").Select Range("B1").Activate Application.CutCopyMode = False Selection.Insert Shift:=xlToRight Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="<", FieldInfo:=Array(1, 3) Sheets("Sheet1").Activate Set rng = Cells.Find(" 072 Run Number:") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 2).Select ActiveCell.Copy Sheets("sheet2").Activate Range("A3").Select ActiveCell.PasteSpecial Sheets("sheet1").Activate Set rng = Cells.Find(" 047 Run Statistics:") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Offset(0, 0).Resize(1, 25).Copy Sheets("sheet2").Activate Range("D3").PasteSpecial Sheets("Sheet1").Activate Set rng = Cells.Find(" 038 Loading Recipe File:") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Copy Sheets("sheet2").Activate Range("C3").Select ActiveCell.PasteSpecial Sheets("sheet1").Activate Sheets("sheet1").Activate Set rng = Cells.Find(" 047 Run Statistics:") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, -1).Select ActiveCell.Offset(0, 0).Resize(50, 11).Copy Sheets("sheet3").Activate Range("A1").Select ActiveCell.PasteSpecial Set rng = Cells.Find("---A---") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Resize(4, 1).Copy Sheets("sheet2").Activate Range("AC3").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Sheets("sheet3").Activate Set rng = Cells.Find("---B---") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Resize(4, 1).Copy Sheets("sheet2").Activate Range("AG3").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Sheets("sheet3").Activate Set rng = Cells.Find("---C---") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Resize(4, 1).Copy Sheets("sheet2").Activate Range("Ak3").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Sheets("sheet3").Activate Set rng = Cells.Find("---D---") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Resize(4, 1).Copy Sheets("sheet2").Activate Range("AO3").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Sheets("sheet3").Activate Set rng = Cells.Find("---E---") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Resize(4, 1).Copy Sheets("sheet2").Activate Range("AS3").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Sheets("sheet3").Activate Set rng = Cells.Find("---F---") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Resize(4, 1).Copy Sheets("sheet2").Activate Range("AW3").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Sheets("sheet3").Activate Set rng = Cells.Find("---G---") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Resize(4, 1).Copy Sheets("sheet2").Activate Range("BA3").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Sheets("sheet3").Activate Set rng = Cells.Find("---H---") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Resize(4, 1).Copy Sheets("sheet2").Activate Range("Be3").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Sheets("sheet3").Activate Set rng = Cells.Find("---I---") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Resize(4, 1).Copy Sheets("sheet2").Activate Range("BI3").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Sheets("Sheet3").Activate Set rng = Cells.Find(" 063 Bias kWh:") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Copy Sheets("sheet2").Activate Range("BN3").Select ActiveCell.PasteSpecial Sheets("Sheet3").Activate Set rng = Cells.Find(" 091 Bias Ah:") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Copy Sheets("sheet2").Activate Range("BO3").Select ActiveCell.PasteSpecial Sheets("Sheet3").Activate Set rng = Cells.Find(" 064 Total Number of Arcs:") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Copy Sheets("sheet2").Activate Range("BP3").Select ActiveCell.PasteSpecial Sheets("Sheet1").Activate Set rng = Cells.Find(" 044 Total Run Time (Minutes):") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Copy Sheets("sheet2").Activate Range("BQ3").Select ActiveCell.PasteSpecial Sheets("Sheet1").Activate Set rng = Cells.Find(" 043 Door Open Time (Minutes):") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Copy Sheets("sheet2").Activate Range("BR3").Select ActiveCell.PasteSpecial Sheets("sheet2").Activate Range("B3").Select ActiveCell.FormulaR1C1 = _ "=COUNTIF(Sheet1!R[-2]C:R[1997]C,"" 018 Automated Run Aborted"")" Range("BS3").Select ActiveCell.FormulaR1C1 = _ "=COUNTIF(Sheet1!R[-2]C[-69]:R[1997]C[-69],"" 001 ***ALARM***"")" With Sheets("sheet1").Range("B:B") On Error Resume Next Set oCell = .Find(What:="051", LookAt:=xlPart) If Not oCell Is Nothing Then sFirst = oCell.Address Do oCell.Offset(0, 1).Copy Sheets("sheet7").Activate Range("A1").PasteSpecial Selection.Insert Shift:=xlDown Sheets("sheet1").Activate Set oCell = .FindNext(oCell) Loop While Not oCell Is Nothing And oCell.Address < sFirst End If End With With Sheets("sheet1").Range("B:B") On Error Resume Next Set oCell = .Find(What:="054", LookAt:=xlPart) If Not oCell Is Nothing Then sFirst = oCell.Address Do oCell.Offset(0, 1).Copy Sheets("sheet7").Activate Range("B1").PasteSpecial Selection.Insert Shift:=xlDown Sheets("sheet1").Activate Set oCell = .FindNext(oCell) Loop While Not oCell Is Nothing And oCell.Address < sFirst End If Sheets("sheet7").Activate Cells.Select Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Range("A1:B1").Select Selection.Copy Application.CutCopyMode = False Range("A1:B1").Select Selection.Cut Sheets("Sheet2").Select ActiveWindow.LargeScroll ToRight:=3 Range("BZ3").Select ActiveSheet.Paste Sheets("Sheet7").Select Range("A2:B2").Select Selection.Cut Sheets("Sheet2").Select Range("CB3").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=6 Range("CD3").Select Sheets("Sheet7").Select Range("A3:B3").Select Selection.Cut Sheets("Sheet2").Select ActiveSheet.Paste Range("CF3").Select Sheets("Sheet7").Select Range("A4:B4").Select Selection.Copy Sheets("Sheet2").Select Selection.Copy Sheets("Sheet2").Select Sheets("Sheet7").Select Application.CutCopyMode = False Selection.Cut Sheets("Sheet2").Select Range("CF3").Select ActiveSheet.Paste Sheets("Sheet7").Select Range("A5:B5").Select Selection.Cut Sheets("Sheet2").Select ActiveWindow.SmallScroll ToRight:=2 Range("CH3").Select ActiveSheet.Paste Sheets("Sheet7").Select Range("A6:B6").Select Selection.Cut Sheets("Sheet2").Select Range("CJ3").Select ActiveSheet.Paste Range("CI12").Select End With Sheets("Sheet6").Select Range("a1").Select Selection.Copy Sheets("Sheet8").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :=" ", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _ 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _ , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _ Array(19, 1), Array(20, 1)) ActiveWindow.SmallScroll ToRight:=8 Range("R2").Select ActiveCell.Replace What:=",", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Cells.Find(What:=",", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _ .Activate Range("V2").Select ActiveCell.FormulaR1C1 = "=RC[-6]&"", ""&RC[-5]&"" ""&RC[-4]" Range("W2").Select ActiveCell.FormulaR1C1 = "=RC[-4]&"" ""&RC[-3]" Range("V2:W2").Select Selection.Copy Range("Y2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("Z2").Select ActiveCell.Replace What:="x", Replacement:=":", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Cells.Find(What:="x", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _ .Activate Range("Z2").Select Selection.TextToColumns Destination:=Range("Z2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _ :=" ", FieldInfo:=Array(1, 2) ActiveWindow.SmallScroll ToRight:=2 Range("AB2").Select ActiveCell.FormulaR1C1 = "=RC[-2]& "" ""&RC[-3]" Range("AB2").Select ActiveWindow.SmallScroll ToRight:=5 Range("AB2").Select Selection.Copy Range("AC2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Selection.TextToColumns Destination:=Range("AC2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _ :=" ", FieldInfo:=Array(1, 3) Selection.Copy Sheets("Sheet2").Select ActiveWindow.LargeScroll ToRight:=4 Range("CL3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Selection.NumberFormat = "mm/dd/yy" Range("CM9").Select Workbooks("P124.xls").Activate Sheets("sheet1").Activate Rows("3:3").Select Selection.Insert Shift:=xlDown Workbooks("CODE.xls").Activate Sheets("sheet2").Activate Rows("3:3").Select Selection.Copy Workbooks("P124.xls").Activate Sheets("sheet1").Activate Range("a3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Workbooks("P124.xls").Activate Sheets("sheet1").Activate Workbooks("code.xls").Activate Sheets("sheet8").Select Cells.Select Selection.ClearContents Sheets("Sheet7").Select Cells.Select Selection.ClearContents Sheets("Sheet6").Select Cells.Select Selection.ClearContents Sheets("Sheet4").Select Cells.Select Selection.ClearContents Sheets("Sheet1").Select Cells.Select Selection.ClearContents Sheets("Sheet3").Select Cells.Select Selection.ClearContents Sheets("Sheet2").Select Range("CL3").Select Selection.ClearContents Range("CK3").Select Selection.ClearContents Range("CJ3").Select Selection.ClearContents Range("CI3").Select Selection.ClearContents Range("CH3").Select Selection.ClearContents Range("CG3").Select Selection.ClearContents Range("CF3").Select Selection.ClearContents Range("CE3").Select Selection.ClearContents Range("CD3").Select Selection.ClearContents Range("CC3").Select Selection.ClearContents Range("CB3").Select Selection.ClearContents Range("CA3").Select Selection.ClearContents Range("BZ3").Select Selection.ClearContents Range("BR3").Select Selection.ClearContents Range("BQ3").Select Selection.ClearContents Range("BP3").Select Selection.ClearContents Range("BO3").Select Selection.ClearContents Range("BN3").Select Selection.ClearContents Range("BL3").Select Selection.ClearContents Range("BK3").Select Selection.ClearContents Range("BJ3").Select Selection.ClearContents Range("BI3").Select Selection.ClearContents Range("BH3").Select Selection.ClearContents Range("BG3").Select Selection.ClearContents Range("BF3").Select Selection.ClearContents Range("BE3").Select Selection.ClearContents Range("BD3").Select Selection.ClearContents Range("BC3").Select Selection.ClearContents Range("BB3").Select Selection.ClearContents Range("BA3").Select Selection.ClearContents Range("AZ3").Select Selection.ClearContents Range("AY3").Select Selection.ClearContents Range("AX3").Select Selection.ClearContents Range("AW3").Select Selection.ClearContents Range("AV3").Select Selection.ClearContents Range("AU3").Select Selection.ClearContents Range("AT3").Select Selection.ClearContents Range("AS3").Select Selection.ClearContents Range("AR3").Select Selection.ClearContents Range("AQ3").Select Selection.ClearContents Range("AP3").Select Selection.ClearContents Range("AO3").Select Selection.ClearContents Range("AN3").Select Selection.ClearContents Range("AM3").Select Selection.ClearContents Range("AL3").Select Selection.ClearContents Range("AK3").Select Selection.ClearContents Range("AJ3").Select Selection.ClearContents Range("AI3").Select Selection.ClearContents Range("AH3").Select Selection.ClearContents Range("AG3").Select Selection.ClearContents Range("AF3").Select Selection.ClearContents Range("AE3").Select Selection.ClearContents Range("AD3").Select Selection.ClearContents Range("AC3").Select Selection.ClearContents Range("AB3").Select Selection.ClearContents Range("AA3").Select Selection.ClearContents Range("Z3").Select Selection.ClearContents Range("Y3").Select Selection.ClearContents Range("X3").Select Selection.ClearContents Range("W3").Select Selection.ClearContents Range("V3").Select Selection.ClearContents Range("U3").Select Selection.ClearContents Range("T3").Select Selection.ClearContents Range("S3").Select Selection.ClearContents Range("R3").Select Selection.ClearContents Range("Q3").Select Selection.ClearContents Range("P3").Select Selection.ClearContents Range("O3").Select Selection.ClearContents Range("N3").Select Selection.ClearContents Range("M3").Select Selection.ClearContents Range("L3").Select Selection.ClearContents Range("K3").Select Selection.ClearContents Range("J3").Select Selection.ClearContents Range("I3").Select Selection.ClearContents Range("H3").Select Selection.ClearContents Range("G3").Select Selection.ClearContents Range("F3").Select Selection.ClearContents Range("E3").Select Selection.ClearContents Range("D3").Select Selection.ClearContents Range("C3").Select Selection.ClearContents Range("A3").Select Selection.ClearContents Range("H10").Select ChDir _ "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files\" On Error Resume Next Kill "1.dat" On Error GoTo 0 ChDir _ "C:\Documents and Settings\Owner\Desktop\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files\" On Error Resume Next Kill "1.txt" On Error GoTo 0 Loop End Sub __________________________________________________ _______________________________________________ |
| All times are GMT +1. The time now is 11:42 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com