+ Reply to Thread
Results 1 to 7 of 7

Problem with file finding macro

  1. #1
    Forum Expert Alf's Avatar
    Join Date
    03-13-2004
    Location
    Gothenburg/Mullsjoe, Sweden
    MS-Off Ver
    Excel 2019 and not sure I like it
    Posts
    4,758

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

  2. #2
    RB Smissaert
    Guest

    Re: 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" <[email protected]> wrote in message
    news:[email protected]...
    >
    > 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
    >



  3. #3
    Forum Expert Alf's Avatar
    Join Date
    03-13-2004
    Location
    Gothenburg/Mullsjoe, Sweden
    MS-Off Ver
    Excel 2019 and not sure I like it
    Posts
    4,758
    Thank you sooo much RB!

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

  4. #4
    RB Smissaert
    Guest

    Re: 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 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


    "Alf" <[email protected]> wrote in message
    news:[email protected]...
    >
    > 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
    >



  5. #5
    RB Smissaert
    Guest

    Re: 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" <[email protected]> wrote in message
    news:[email protected]...
    >
    > 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
    >



  6. #6
    Forum Expert Alf's Avatar
    Join Date
    03-13-2004
    Location
    Gothenburg/Mullsjoe, Sweden
    MS-Off Ver
    Excel 2019 and not sure I like it
    Posts
    4,758
    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??

  7. #7
    RB Smissaert
    Guest

    Re: 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" <[email protected]> wrote in message
    news:[email protected]...
    >
    > 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
    >



+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1