Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
open all files in directory
Hi, I am trying to use Ron de Bruin's code "Change cells or range in all
workbooks in a folder" to open files in a directory on my C:\ drive. The variable "MyPath" is locating the directory but after the ReDim Preserve command the variable "Fnum" is saying "Subscript out of range" and the code resumes at the endif statement of the "If Not mybook Is Nothing Then" routine. I am at a loss as to why this is happening, (probably due to lack of experience), and would appreciate any help as I am trying to adapt this to copy and paste operation on 10 directories with more than 50 excel files in each one. Code posted below. Thanks. Davie Sub openfiles() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String, Fnum As Long Dim mybook As Workbook Dim CalcMode As Long Dim sh As Worksheet Dim ErrorYes As Boolean 'Fill in the path\folder where the files are MyPath = "C:\Davie\expenses" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop End If 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual '.ScreenUpdating = False .EnableEvents = False End With 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then 'Change cell value(s) in one worksheet in mybook On Error Resume Next With mybook.Worksheets(71) If .ProtectContents = False Then .Range("A1").Value = "My New Header" Else ErrorYes = True End If End With If Err.Number 0 Then ErrorYes = True Err.Clear 'Close mybook without saving mybook.Close savechanges:=False Else 'Save and close mybook mybook.Close savechanges:=True End If On Error GoTo 0 Else 'Not possible to open the workbook ErrorYes = True End If Next Fnum End If If ErrorYes = True Then MsgBox "There are problems in one or more files, possible problem:" _ & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" End If 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
open all files in directory
There was a seemingly mis-placed End IF. This seems to work
Sub openfiles() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String, Fnum As Long Dim mybook As Workbook Dim CalcMode As Long Dim sh As Worksheet Dim ErrorYes As Boolean 'Fill in the path\folder where the files are MyPath = "C:\test" '"C:\Davie\expenses" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual '.ScreenUpdating = False .EnableEvents = False End With 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then 'Change cell value(s) in one worksheet in mybook On Error Resume Next With mybook.Worksheets(71) If .ProtectContents = False Then .Range("A1").Value = "My New Header" Else ErrorYes = True End If End With If Err.Number 0 Then ErrorYes = True Err.Clear 'Close mybook without saving mybook.Close savechanges:=False Else 'Save and close mybook mybook.Close savechanges:=True End If On Error GoTo 0 Else 'Not possible to open the workbook ErrorYes = True End If Next Fnum End If If ErrorYes = True Then MsgBox "There are problems in one or more files, possible problem:" _ & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" End If 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub -- __________________________________ HTH Bob "davethewelder" wrote in message ... Hi, I am trying to use Ron de Bruin's code "Change cells or range in all workbooks in a folder" to open files in a directory on my C:\ drive. The variable "MyPath" is locating the directory but after the ReDim Preserve command the variable "Fnum" is saying "Subscript out of range" and the code resumes at the endif statement of the "If Not mybook Is Nothing Then" routine. I am at a loss as to why this is happening, (probably due to lack of experience), and would appreciate any help as I am trying to adapt this to copy and paste operation on 10 directories with more than 50 excel files in each one. Code posted below. Thanks. Davie Sub openfiles() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String, Fnum As Long Dim mybook As Workbook Dim CalcMode As Long Dim sh As Worksheet Dim ErrorYes As Boolean 'Fill in the path\folder where the files are MyPath = "C:\Davie\expenses" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop End If 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual '.ScreenUpdating = False .EnableEvents = False End With 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then 'Change cell value(s) in one worksheet in mybook On Error Resume Next With mybook.Worksheets(71) If .ProtectContents = False Then .Range("A1").Value = "My New Header" Else ErrorYes = True End If End With If Err.Number 0 Then ErrorYes = True Err.Clear 'Close mybook without saving mybook.Close savechanges:=False Else 'Save and close mybook mybook.Close savechanges:=True End If On Error GoTo 0 Else 'Not possible to open the workbook ErrorYes = True End If Next Fnum End If If ErrorYes = True Then MsgBox "There are problems in one or more files, possible problem:" _ & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" End If 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
open all files in directory
It is working fine now. Many thanks.
Davie "Bob Phillips" wrote: There was a seemingly mis-placed End IF. This seems to work Sub openfiles() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String, Fnum As Long Dim mybook As Workbook Dim CalcMode As Long Dim sh As Worksheet Dim ErrorYes As Boolean 'Fill in the path\folder where the files are MyPath = "C:\test" '"C:\Davie\expenses" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual '.ScreenUpdating = False .EnableEvents = False End With 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then 'Change cell value(s) in one worksheet in mybook On Error Resume Next With mybook.Worksheets(71) If .ProtectContents = False Then .Range("A1").Value = "My New Header" Else ErrorYes = True End If End With If Err.Number 0 Then ErrorYes = True Err.Clear 'Close mybook without saving mybook.Close savechanges:=False Else 'Save and close mybook mybook.Close savechanges:=True End If On Error GoTo 0 Else 'Not possible to open the workbook ErrorYes = True End If Next Fnum End If If ErrorYes = True Then MsgBox "There are problems in one or more files, possible problem:" _ & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" End If 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub -- __________________________________ HTH Bob "davethewelder" wrote in message ... Hi, I am trying to use Ron de Bruin's code "Change cells or range in all workbooks in a folder" to open files in a directory on my C:\ drive. The variable "MyPath" is locating the directory but after the ReDim Preserve command the variable "Fnum" is saying "Subscript out of range" and the code resumes at the endif statement of the "If Not mybook Is Nothing Then" routine. I am at a loss as to why this is happening, (probably due to lack of experience), and would appreciate any help as I am trying to adapt this to copy and paste operation on 10 directories with more than 50 excel files in each one. Code posted below. Thanks. Davie Sub openfiles() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String, Fnum As Long Dim mybook As Workbook Dim CalcMode As Long Dim sh As Worksheet Dim ErrorYes As Boolean 'Fill in the path\folder where the files are MyPath = "C:\Davie\expenses" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop End If 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual '.ScreenUpdating = False .EnableEvents = False End With 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then 'Change cell value(s) in one worksheet in mybook On Error Resume Next With mybook.Worksheets(71) If .ProtectContents = False Then .Range("A1").Value = "My New Header" Else ErrorYes = True End If End With If Err.Number 0 Then ErrorYes = True Err.Clear 'Close mybook without saving mybook.Close savechanges:=False Else 'Save and close mybook mybook.Close savechanges:=True End If On Error GoTo 0 Else 'Not possible to open the workbook ErrorYes = True End If Next Fnum End If If ErrorYes = True Then MsgBox "There are problems in one or more files, possible problem:" _ & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" End If 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Open files in the same directory | Excel Discussion (Misc queries) | |||
Macro - Open all word files in a directory | Excel Worksheet Functions | |||
List of Files in A Directory | Excel Discussion (Misc queries) | |||
Files in a directory? | Excel Discussion (Misc queries) | |||
Load all files in a directory | Excel Discussion (Misc queries) |