Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Trap a find error | Excel Programming | |||
Error Trap Not Working | Excel Programming | |||
Trap a DateValue Error | Excel Programming | |||
error trap | Excel Programming |