[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
Solved

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

Posted on 2011-04-19
Medium Priority
382 Views
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.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
SourceWb.Activate

'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
TargetWb.Activate

'get last non-empty row in TargetWs
With TargetWs
.Select
.Range("A1").Select
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
Next
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
SourceWs.Activate
SourceRange.Select
Selection.Copy
TargetWs.Activate
TargetRange.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False

'get last column
TargetWs.Activate
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

Range("A" & LastRowAgreementDb).Select

'close SourceWb
SourceWb.Close False

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

ee-agreement-base.xls
ee-company-details-BANANA.xls
0
Question by:stmoritz
• 6
• 3

LVL 19

Accepted Solution

Arno Koster earned 1200 total points
ID: 35425022
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
wend

0

LVL 19

Assisted Solution

Arno Koster earned 1200 total points
ID: 35425041
It might be very usefull to include the path to the files to open :

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

Author Comment

ID: 35425380
Thanks akoster.

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

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

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


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

Author Comment

ID: 35425508

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

LVL 19

Expert Comment

ID: 35425517
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
wend


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

Author Comment

ID: 35425586
sorry. my post was erroneus. should of course be

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


will check now how it works...
0

Author Comment

ID: 35425658
i get the following error, although the file is there...??
screenshot.jpg
0

LVL 85

Expert Comment

ID: 35425772
(NFP)
Dir only returns the filename, so you have to add the path on when using Workbooks.open
0

Author Comment

ID: 35425801
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)
0

Author Closing Comment

ID: 35425820
thank you very much!
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
###### Suggested Courses
Course of the Month19 days, 21 hours left to enroll