#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 18
Default Error Trap

I have 484 files in the same directory. I want to loop through all the
workbooks and add a sheet called "Memo".

I have the code to add the sheet. How do I handle the error when it already
has a sheet named "Memo" and go to the next file?

Here's the code I'm using:

Sub Memo_Test()

Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir

MyPath = "C:\Documents and Settings\Consultant\My
Documents\Partnerships\Carol Bynum\Test Files"
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

On Error GoTo CleanUp
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
Do While FNames < ""
Set mybook = Workbooks.Open(FNames, UpdateLinks:=0)

basebook.Worksheets("Sheet1").Copy
after:=mybook.Sheets(mybook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = basebook.Name
On Error GoTo 0
mybook.Close True
FNames = Dir()
Loop

CleanUp:
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 17
Default Error Trap

You can do this in a few ways. I would do it thus:
Sub Main1
'Open your file
Set wb = workbooks.open (myFileName)
'Check using the function below
If not fcnCheckWorkSheetAlreadyExists("Memo",wb ) then
'Add your worksheet
end if
End Sub

Function fcnCheckWorkSheetAlreadyExists(myName as string, wb as workbook) as
boolean
Dim sh as worksheet
on error resume next
set sh = wb.sheets(myName)
on error goto 0
If sh is nothing then exit Function
fcnCheckWorkSheetAlreadyExists1 = True
set sh = nothing
End Function

HTH,
Gareth


"TEB2" wrote in message
...
I have 484 files in the same directory. I want to loop through all the
workbooks and add a sheet called "Memo".

I have the code to add the sheet. How do I handle the error when it

already
has a sheet named "Memo" and go to the next file?

Here's the code I'm using:

Sub Memo_Test()

Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir

MyPath = "C:\Documents and Settings\Consultant\My
Documents\Partnerships\Carol Bynum\Test Files"
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

On Error GoTo CleanUp
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
Do While FNames < ""
Set mybook = Workbooks.Open(FNames, UpdateLinks:=0)

basebook.Worksheets("Sheet1").Copy
after:=mybook.Sheets(mybook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = basebook.Name
On Error GoTo 0
mybook.Close True
FNames = Dir()
Loop

CleanUp:
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default Error Trap

Sub Memo_Test()

Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir

MyPath = "C:\Documents and Settings\Consultant\My " & _
"Documents\Partnerships\Carol Bynum\Test Files"
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

On Error GoTo CleanUp
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
Do While FNames < ""
Set mybook = Workbooks.Open(FNames, UpdateLinks:=0)

basebook.Worksheets("Sheet1").Copy _
after:=mybook.Sheets(mybook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = basebook.Name
if err.number = 0 then
mybook.Close True
else
mybook.close False
end if
On Error goto 0
FNames = Dir()
Loop

CleanUp:
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

--
Regards,
Tom Ogilvy

"TEB2" wrote in message
...
I have 484 files in the same directory. I want to loop through all the
workbooks and add a sheet called "Memo".

I have the code to add the sheet. How do I handle the error when it

already
has a sheet named "Memo" and go to the next file?

Here's the code I'm using:

Sub Memo_Test()

Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir

MyPath = "C:\Documents and Settings\Consultant\My
Documents\Partnerships\Carol Bynum\Test Files"
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

On Error GoTo CleanUp
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
Do While FNames < ""
Set mybook = Workbooks.Open(FNames, UpdateLinks:=0)

basebook.Worksheets("Sheet1").Copy
after:=mybook.Sheets(mybook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = basebook.Name
On Error GoTo 0
mybook.Close True
FNames = Dir()
Loop

CleanUp:
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Trap a find error quartz[_2_] Excel Programming 2 December 10th 04 01:21 AM
Error Trap Not Working Otto Moehrbach[_6_] Excel Programming 7 April 13th 04 12:15 PM
Trap a DateValue Error Otto Moehrbach[_6_] Excel Programming 2 February 12th 04 04:51 PM
error trap Rhonda[_3_] Excel Programming 2 October 22nd 03 07:07 PM


All times are GMT +1. The time now is 03:46 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"