Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hey,
I am using a macro to open up unknown files from one folder, put them in another and change the name. I pull out all the necessary data and then clear everything and close everything. But what happens is that once there are no more files in the folders it ends on error 53 reun time error. What I would like to happen in this code is that if on the first loop it does not find and files in the folders a message box pops up and tells the user that there is no data to process. If there are files once the macro is done it starts another macro. Please help !!!! ================================================== ========================= Do ChDir "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\Data log trending Version 2.0\Data log files (by machine) \P124\TXT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\Data log trending Version 2.0\Data log files (by machine) \P124\DAT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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 = "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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 = "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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:= _ "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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:= _ "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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("Run Number") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Copy Sheets("sheet2").Activate Range("A3").Select ActiveCell.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 Range("E1").Select Set rng = Cells.Find("034 Data Recording Finished") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, -1).Select On Error Resume Next ActiveCell.Offset(-100, 0).Resize(100, 40).Copy Sheets("sheet3").Activate Range("A1").Select ActiveCell.PasteSpecial On Error GoTo 0 Sheets("sheet3").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("sheet3").Activate 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 On Error Resume Next Kill "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\Data log trending Version 2.0\Data log files (by machine)\P124\Known dat files\*.dat" On Error GoTo 0 On Error Resume Next Kill "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\Data log trending Version 2.0\Data log files (by machine)\P124\Known txt files\*.txt" On Error GoTo 0 Loop |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Where specifically is the error?
I did clean up some of the code at the end where you clear contents on a whole bunch of individual cells. This can be done this way Sub Test() Dim mySheet As Worksheet Dim myRange As Range Set myWS = ThisWorkbook.Sheets("Sheet2") Set myRange = Union(myWS.Range("A3"), myWS.Range("H3"), myWS.Range("C3:BL3"), myWS.Range("BN3:BR3"), myWS.Range("BZ3:CL3")) myRange.ClearContents End Sub -- HTH, Barb Reinhardt " wrote: Hey, I am using a macro to open up unknown files from one folder, put them in another and change the name. I pull out all the necessary data and then clear everything and close everything. But what happens is that once there are no more files in the folders it ends on error 53 reun time error. What I would like to happen in this code is that if on the first loop it does not find and files in the folders a message box pops up and tells the user that there is no data to process. If there are files once the macro is done it starts another macro. Please help !!!! ================================================== ========================= Do ChDir "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\Data log trending Version 2.0\Data log files (by machine) \P124\TXT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\Data log trending Version 2.0\Data log files (by machine) \P124\DAT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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 = "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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 = "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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:= _ "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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:= _ "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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("Run Number") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Copy Sheets("sheet2").Activate Range("A3").Select ActiveCell.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 Range("E1").Select Set rng = Cells.Find("034 Data Recording Finished") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, -1).Select On Error Resume Next ActiveCell.Offset(-100, 0).Resize(100, 40).Copy Sheets("sheet3").Activate Range("A1").Select ActiveCell.PasteSpecial On Error GoTo 0 Sheets("sheet3").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("sheet3").Activate 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 |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi,
Insert this statement before your iteration if myfyles.count= 0 then msgbox "no file found" exit sub end if -- Regards Jean-Yves Tfelt Europe " wrote: Hey, I am using a macro to open up unknown files from one folder, put them in another and change the name. I pull out all the necessary data and then clear everything and close everything. But what happens is that once there are no more files in the folders it ends on error 53 reun time error. What I would like to happen in this code is that if on the first loop it does not find and files in the folders a message box pops up and tells the user that there is no data to process. If there are files once the macro is done it starts another macro. Please help !!!! ================================================== ========================= Do ChDir "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\Data log trending Version 2.0" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\Data log trending Version 2.0\Data log files (by machine) \P124\TXT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\Data log trending Version 2.0\Data log files (by machine) \P124\DAT\" & tmp.Sheets(1).Cells(Count, 1).Value) f2.Move ("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\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 = "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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 = "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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:= _ "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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:= _ "\\Mascarolinabdc\puball\Newport Precision\Spreadsheets\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("Run Number") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, 1).Select ActiveCell.Copy Sheets("sheet2").Activate Range("A3").Select ActiveCell.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 Range("E1").Select Set rng = Cells.Find("034 Data Recording Finished") If Not rng Is Nothing Then rng.Select Else End If ActiveCell.Offset(0, -1).Select On Error Resume Next ActiveCell.Offset(-100, 0).Resize(100, 40).Copy Sheets("sheet3").Activate Range("A1").Select ActiveCell.PasteSpecial On Error GoTo 0 Sheets("sheet3").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("sheet3").Activate 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 |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\Data log trending Version 2.0\Data log files (by machine) \P124\TXT") This is where I first get the error. I put a on error resume next before it and a on error goto 0 after it and then it does the same at the next one. If possible once this happens the first time I want it to exit the macro |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
why don't you try the method i posted in your earlier post?
-- Gary wrote in message ... Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder("\\Mascarolinabdc\puball\Newport Precision \Spreadsheets\Data log trending Version 2.0\Data log files (by machine) \P124\TXT") This is where I first get the error. I put a on error resume next before it and a on error goto 0 after it and then it does the same at the next one. If possible once this happens the first time I want it to exit the macro |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Error handling error # 1004 Run-time error | Excel Programming | |||
Error Handling - On Error GoTo doesn't trap error successfully | Excel Programming | |||
Form Err.Raise error not trapped by entry procedure error handler | Excel Programming | |||
Automation Error, Unknown Error. Error value - 440 | Excel Programming |