Problem with file finding macro

A

Alf

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
 
R

RB Smissaert

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
 
A

Alf

Thank you sooo much RB!

Macro worked perfectly. Now I'm going to study it to see how it works.
 
R

RB Smissaert

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 here:
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
 
R

RB Smissaert

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
 
A

Alf

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?
 
R

RB Smissaert

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top