Run Excel VBA code on all files in a folder except one (the one with the code)

Posted on 2011-04-19
Last Modified: 2012-05-11
I am looking to change the following code as follows:

Currently, the active workbook where the code is run from is the target workbook that fetches data from the source workbook C:\!ee\AgreementBase\ee_company_details_BANANA.xls

Now the code should be changed so that it processes any file in this folder except the target file. So there might be twenty others like ee_company_details_APPLE.xls, ee_company_details_ORANGE.xls etc. and the data from these sheets should all be added in the same way like the BANANA one...
Sub FetchDataFromIndividualFilesToDb()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.AutomationSecurity = msoAutomationSecurityLow

'dim the variables
Dim ActiveCompany As String, ActiveCompanyRowInDb As Integer, LastRowAgreementDb As Integer, ActiveCompanyRow As Integer, LastColTargetWs As Integer

'dim the ranges
Dim TargetRange As Range, SourceRange As Range, SortRange As Range, SourceCompanyCodeRange As Range, TargetCompanyCodeRange As Range

'dim the workbooks
Dim TargetWb As Workbook, SourceWb As Workbook

'dim the worksheets
Dim TargetWs As Worksheet, SourceWs As Worksheet

'set and open workbooks
Set TargetWb = ActiveWorkbook
Set SourceWb = Workbooks.Open("C:\!ee\AgreementBase\ee_company_details_BANANA.xls")
'Set TargetWb = Workbooks("ee_agreement_base.xls")

'set worksheets
Set TargetWs = TargetWb.Sheets("AgreementData")
Set SourceWs = SourceWb.Sheets("CompanyData")

'activate SourceWb

'get Company Code to process
ActiveCompany = SourceWs.Range("B41").Value
If ActiveCompany = "" Then
                  TargetWb.Close False
                  Exit Sub
End If
'ActiveCompanyRow = ActiveCell.Row

'ask whether to send this Company to db
OverWrite = MsgBox("Add data for " & ActiveCompany & " to ee_agreement_base.xls?", vbYesNo)
            If OverWrite = vbNo Then Exit Sub

'activate TargetWb

'get last non-empty row in TargetWs
With TargetWs
End With
LastRowAgreementDb = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row

'search for the Company code in TargetWs
For i = 1 To LastRowAgreementDb
    If TargetWs.Range("A" & i).Value = ActiveCompany Then Exit For
TargetCompanyRow = i

'set source and target range
Set SourceRange = SourceWs.Range("D2:D38")
Set SourceCompanyCodeRange = SourceWs.Range("B41")
Set TargetCompanyCodeRange = TargetWs.Range("A" & TargetCompanyRow)
Set TargetRange = TargetWs.Range("B" & TargetCompanyRow & ":AL" & TargetCompanyRow)

'overwrite company code in target ws
TargetCompanyCodeRange = SourceCompanyCodeRange.Value

'copy paste company data to target ws
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Application.CutCopyMode = False

'get last column
LastColTargetWs = Cells(1, Columns.Count).End(xlToLeft).Column

'sort agreement db alphabetically
If TargetCompanyRow > LastRowAgreementDb Then
   Set SortRange = TargetWs.Range(TargetWs.Cells(2, 1), TargetWs.Cells(TargetCompanyRow, LastColTargetWs))
       Else: Set SortRange = TargetWs.Range(TargetWs.Cells(2, 1), TargetWs.Cells(LastRowAgreementDb, LastColTargetWs))
End If
SortRange.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo
Range("A" & LastRowAgreementDb).Select

'close SourceWb
SourceWb.Close False

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = True
Application.AutomationSecurity = msoAutomationSecurityByUI
End Sub

Open in new window

Question by:stmoritz
    LVL 19

    Accepted Solution

    you could use a structure like :
    'set and open workbooks
    Set TargetWb = ActiveWorkbook
    activeFile = dir("C:\!ee\AgreementBase\*.xls")
    while activeFile <> "" 
        Set SourceWb = Workbooks.Open(activefile)
        'Set TargetWb = Workbooks("ee_agreement_base.xls")
       SourceWB.Close False
       activeFile = dir

    Open in new window

    LVL 19

    Assisted Solution

    It might be very usefull to include the path to the files to open :

    Set SourceWb = Workbooks.Open("C:\!ee\AgreementBase\" & activefile)

    Author Comment

    Thanks akoster.

    Before I check a quick ignorant question (forgive me):

    could I change
    activeFile = dir("C:\!ee\AgreementBase\*.xls")

    Open in new window

    activeFile = dir("C:\!ee\AgreementBase\ee_agreement_base*.xls")

    Open in new window

    What I don't see is how this change would now for example process all the ee_agreement_base".xls in that folder one after the other, I mean I see no loop or so... shall I just test it?

    Author Comment

    sorry. should read:

    What I don't see is how this change would now for example process all the ee_agreement_base*.xls in that folder one after the other, I mean I see no loop or so... shall I just test it?

    (* instead of " is correct)
    LVL 19

    Expert Comment

    no need to ask for forgiveness !

    that would indeed be no problem at all, then you would only act on excel files starting with ee_agreement_base.

    The finesse is in the use of the DIR statement.

    If you are not confortable using it, try running this small macro :
    sub test_dir_function()
    dim result as string
       result = dir("C:\!ee\AgreementBase\ee_agreement_base*.xls")
       while result <> ""
          msgbox result
          result = dir

    Open in new window

    it will find all ee_agreenent_base excel files and display their names with message boxes.

    Author Comment

    sorry. my post was erroneus. should of course be

    activeFile = dir("C:\!ee\AgreementBase\ee_company_details_*.xls")

    Open in new window

    will check now how it works...

    Author Comment

    i get the following error, although the file is there...??
    LVL 85

    Expert Comment

    by:Rory Archibald
    Dir only returns the filename, so you have to add the path on when using

    Author Comment

    thanks rorya. again, I didn't read the helping expert answers carefully. you pointed me at this again.

    I think I didn't incorporate ID: 35425041:
    Set SourceWb = Workbooks.Open("C:\!ee\AgreementBase\" & activefile)

    Author Closing Comment

    thank you very much!

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Looking for New Ways to Advertise?

    Engage with tech pros in our community with native advertising, as a Vendor Expert, and more.

    Suggested Solutions

    Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
    This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
    This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
    This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    15 Experts available now in Live!

    Get 1:1 Help Now