Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...
MS Office Forum / Excel / Programming / August 2008

Tip: Looking for answers? Try searching our database.

run time error 53

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
s_smith_iet@hotmail.com - 17 Aug 2008 21:29 GMT
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
Reply to this Message
OssieMac - 18 Aug 2008 02:34 GMT
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.

Signature

Regards,

OssieMac

> 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
[quoted text clipped - 85 lines]
>
> Please help
Reply to this Message
s_smith_iet@hotmail.com - 18 Aug 2008 02:57 GMT
On Aug 17, 9:34 pm, OssieMac <Ossie...@discussions.microsoft.com>
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
[quoted text clipped - 41 lines]
> > \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
Reply to this Message
s_smith_iet@hotmail.com - 18 Aug 2008 03:00 GMT
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
Reply to this Message
s_smith_iet@hotmail.com - 18 Aug 2008 03:08 GMT
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.......
Reply to this Message
JLGWhiz - 18 Aug 2008 04:02 GMT
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

> 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.......
Reply to this Message
OssieMac - 18 Aug 2008 04:13 GMT
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.

Signature

Regards,

OssieMac

> Do
> ChDir "C:\Documents and Settings\Owner\Desktop\Data log trending
[quoted text clipped - 26 lines]
>
> This is where I get the error
Reply to this Message
OssieMac - 18 Aug 2008 04:42 GMT
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

Signature

Regards,

OssieMac

Reply to this Message
s_smith_iet@hotmail.com - 18 Aug 2008 05:06 GMT
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
_________________________________________________________________________________________________
Reply to this Message
JLGWhiz - 18 Aug 2008 02:54 GMT
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.

> 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
[quoted text clipped - 85 lines]
>
> Please help
Reply to this Message
Gary Keramidas - 18 Aug 2008 04:09 GMT
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

Signature

Gary

>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
[quoted text clipped - 85 lines]
>
> Please help
Reply to this Message
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage
Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.