![]() |
Problem with file finding macro
I'm trying to extract from a number of files in a folder. The files are named MS060XXX.0.xls where XXX is a number ranging from 001 to 850. My error handling works if there is only one file missing in the rang of files I want to extract from. If two ore more files are missing the macro stopps with message "fil not found" Could anybody please give me a hint how to solve this problem. Sub Macro1() ' ' Macro1 Macro ' Dim i As Integer For i = Range("I2").Value To Range("I3").Value Step 1 ChDir "E:\beredskap\bensin" Application.ScreenUpdating = False On Error GoTo Err If i < 100 Then Workbooks.Open Filename:="MS0600" & i & ".0.xls" Else Workbooks.Open Filename:="MS060" & i & ".0.xls" End If If FileLen(ActiveWorkbook.FullName) 300000 Then Sheets("Beställning").Activate Range("A2:C2").Copy Windows("select_files.xls").Activate Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecia Paste:=xlValues End If If i < 100 Then Windows("MS0600" & i & ".0.xls").Activate ActiveWorkbook.Close Else Windows("MS060" & i & ".0.xls").Activate ActiveWorkbook.Close End If Err: Next i Application.ScreenUpdating = True End Su -- Al ----------------------------------------------------------------------- Alf's Profile: http://www.excelforum.com/member.php...nfo&userid=711 View this thread: http://www.excelforum.com/showthread.php?threadid=55076 |
Problem with file finding macro
Try this code, which gets the values without opening the workbooks as posted
before. As your copy ranges are small it probably is faster than opening the workbooks. Not tested, but it should work. Sub Macro1() Dim i As Long Dim n As Byte Dim strFolder As String Dim strFile As String Dim strSheet As String Dim arr(1 To 1, 1 To 3) Dim lRow As Long Application.ScreenUpdating = False strFolder = "E:\beredskap\bensin\" strSheet = "Beställning" For i = Range("I2").Value To Range("I3").Value If i < 100 Then strFile = "MS0600" & i & ".0.xls" Else strFile = "MS060" & i & ".0.xls" End If If bFileExists(strFolder & strFile) Then If FileLen(strFolder & strFile) 300000 Then For n = 1 To 3 arr(1, n) = GetValueFromWB(strFolder, _ strFile, _ strSheet, _ Cells(2, n + 2).Address) Next lRow = Cells(65536, 3).End(xlUp).Offset(1, 0).Row Range(Cells(lRow, 3), Cells(lRow, 5)) = arr End If End If Next i Application.ScreenUpdating = True End Sub Function GetValueFromWB(path, file, sheet, ref) 'Retrieves a value from a closed workbook '---------------------------------------- Dim strSep As String Dim arg As String 'Make sure the file exists '------------------------- If Right$(path, 1) < "\" Then path = path & "\" End If If bFileExists(path & file) = False Then GetValueFromWB = "File Not Found" Exit Function End If 'Create the argument '------------------- arg = "'" & path & "[" & file & "]" & sheet & "'!" & _ Range(ref).Range("A1").Address(, , xlR1C1) 'Execute an XLM macro '-------------------- GetValueFromWB = ExecuteExcel4Macro(arg) End Function Function bFileExists(ByVal sFile As String) As Boolean Dim lAttr As Long On Error Resume Next lAttr = GetAttr(sFile) bFileExists = (Err.Number = 0) And ((lAttr And vbDirectory) = 0) On Error GoTo 0 End Function RBS "Alf" wrote in message ... I'm trying to extract from a number of files in a folder. The files are named MS060XXX.0.xls where XXX is a number ranging from 001 to 850. My error handling works if there is only one file missing in the range of files I want to extract from. If two ore more files are missing the macro stopps with message "file not found" Could anybody please give me a hint how to solve this problem. Sub Macro1() ' ' Macro1 Macro ' Dim i As Integer For i = Range("I2").Value To Range("I3").Value Step 1 ChDir "E:\beredskap\bensin" Application.ScreenUpdating = False On Error GoTo Err If i < 100 Then Workbooks.Open Filename:="MS0600" & i & ".0.xls" Else Workbooks.Open Filename:="MS060" & i & ".0.xls" End If If FileLen(ActiveWorkbook.FullName) 300000 Then Sheets("Beställning").Activate Range("A2:C2").Copy Windows("select_files.xls").Activate Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues End If If i < 100 Then Windows("MS0600" & i & ".0.xls").Activate ActiveWorkbook.Close Else Windows("MS060" & i & ".0.xls").Activate ActiveWorkbook.Close End If Err: Next i Application.ScreenUpdating = True End Sub -- Alf ------------------------------------------------------------------------ Alf's Profile: http://www.excelforum.com/member.php...fo&userid=7112 View this thread: http://www.excelforum.com/showthread...hreadid=550766 |
Problem with file finding macro
Thank you sooo much RB! Macro worked perfectly. Now I'm going to study it to see how it works. -- Alf ------------------------------------------------------------------------ Alf's Profile: http://www.excelforum.com/member.php...fo&userid=7112 View this thread: http://www.excelforum.com/showthread...hreadid=550766 |
Problem with file finding macro
No trouble.
If your ranges to copy are getting big then it might be better to get the data with SQL and ADO as described for example he http://www.rondebruin.nl/ado.htm Even with your small ranges this could be faster. Come to think of it I will test and see what is the faster one. RBS "Alf" wrote in message ... Thank you sooo much RB! Macro worked perfectly. Now I'm going to study it to see how it works. -- Alf ------------------------------------------------------------------------ Alf's Profile: http://www.excelforum.com/member.php...fo&userid=7112 View this thread: http://www.excelforum.com/showthread...hreadid=550766 |
Problem with file finding macro
OK, have tested this, but with your 3 cells range the ADO method is about 10
times slower. Another drawback of the ADO method is that you will have to set a reference to the Microsoft ActiveX Data Objects x.x Library. RBS "Alf" wrote in message ... Thank you sooo much RB! Macro worked perfectly. Now I'm going to study it to see how it works. -- Alf ------------------------------------------------------------------------ Alf's Profile: http://www.excelforum.com/member.php...fo&userid=7112 View this thread: http://www.excelforum.com/showthread...hreadid=550766 |
Problem with file finding macro
Thanks again RS fore the help you have given me. I'm still struggeling with your code trying to understand it all but i will take some time before I do. So I'm pleased that SQL and ADO metod are slower since I have much less chance of understanding that. But i was very kind of you to spend time and effort on my behalf. I had a look at link you gave me and realised that this is way above m present VB knowledge. In your code you declaired a variabel: Dim strSep As String I can't see any reson fore it and the macro runs fine without it. guess you used this macro before and modified it to suit my needs. S strSep is a variabel not needed im my case or? -- Al ----------------------------------------------------------------------- Alf's Profile: http://www.excelforum.com/member.php...nfo&userid=711 View this thread: http://www.excelforum.com/showthread.php?threadid=55076 |
Problem with file finding macro
Dim strSep As String
Just take that out it shouldn't be in there. This has to do with systems that have a different path separator, like /. As you only will be running it on Windows you don't have to worry about it. RBS "Alf" wrote in message ... Thanks again RS fore the help you have given me. I'm still struggeling with your code trying to understand it all but it will take some time before I do. So I'm pleased that SQL and ADO metode are slower since I have much less chance of understanding that. But it was very kind of you to spend time and effort on my behalf. I had a look at link you gave me and realised that this is way above my present VB knowledge. In your code you declaired a variabel: Dim strSep As String I can't see any reson fore it and the macro runs fine without it. I guess you used this macro before and modified it to suit my needs. So strSep is a variabel not needed im my case or?? -- Alf ------------------------------------------------------------------------ Alf's Profile: http://www.excelforum.com/member.php...fo&userid=7112 View this thread: http://www.excelforum.com/showthread...hreadid=550766 |
All times are GMT +1. The time now is 12:37 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com