G
goober
I have a spreadsheet that accesses aproximately 30 other workbooks and
returnd data from them. My problem is that the routine that gets the
info opens the workbooks first. Many of these workbooks have broken
links and I have to click on a prompt before the Macro will continue to
the next file. I was hoping someone knows how to either force the macro
to stop the prompt for the broken link or how to access the workbooks
without opening them first. Below is the code I have to retrieve the
information. Any help would be greatly appreciated.
Thanks
Goober.
Sub BubbleNumbers()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim SheetNumber
SheetNumber = InputBox("Please enter the day you want to retrieve data
for. Example: For the first day enter 1.")
If SheetNumber < 1 Then
Call Noise
MsgBox "You must enter a number between 1 and 31"
Exit Sub
End If
If SheetNumber > 31 Then
Call Noise
MsgBox "You must enter a number between 1 and 31"
Exit Sub
End If
SaveDriveDir = CurDir
MyPath = "S:\ROSTER MANAGEMENT\GRAVES\GRAVES 2005\October 05"
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
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
rnum = 1
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange =
mybook.Worksheets(SheetNumber).Range("W104:AF109")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")
basebook.Worksheets(1).Cells(rnum, "k").Value = mybook.Name
sourceRange.Copy destrange
mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
returnd data from them. My problem is that the routine that gets the
info opens the workbooks first. Many of these workbooks have broken
links and I have to click on a prompt before the Macro will continue to
the next file. I was hoping someone knows how to either force the macro
to stop the prompt for the broken link or how to access the workbooks
without opening them first. Below is the code I have to retrieve the
information. Any help would be greatly appreciated.
Thanks
Goober.
Sub BubbleNumbers()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim SheetNumber
SheetNumber = InputBox("Please enter the day you want to retrieve data
for. Example: For the first day enter 1.")
If SheetNumber < 1 Then
Call Noise
MsgBox "You must enter a number between 1 and 31"
Exit Sub
End If
If SheetNumber > 31 Then
Call Noise
MsgBox "You must enter a number between 1 and 31"
Exit Sub
End If
SaveDriveDir = CurDir
MyPath = "S:\ROSTER MANAGEMENT\GRAVES\GRAVES 2005\October 05"
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
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
rnum = 1
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange =
mybook.Worksheets(SheetNumber).Range("W104:AF109")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")
basebook.Worksheets(1).Cells(rnum, "k").Value = mybook.Name
sourceRange.Copy destrange
mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub