I have the following code:
Option Explicit
Randomize
Dim a, song, album
a = Int((Rnd*195)+1)
song = "B" & a
album = "A" & a
Dim objApp, objWbs, objWorkbook, objSheet
Set objApp = CreateObject("Excel.Application")
Set objWbs = objApp.WorkBooks
objApp.Visible = False
Set objWorkbook = objWbs.Open("C:\Users\Name\Documents\Music.xlsx")
Set objSheet = objWorkbook.Sheets("Sheet1")
song = objSheet.Range(song).Value
album = objSheet.Range(album).Value
objWorkbook.Close False
objWbs.Close
objApp.Quit
Set objSheet = Nothing
Set objWorkbook = Nothing
Set objWbs = Nothing
Set objApp = Nothing
MsgBox("Album name: " & album & vbNewLine & "Song name: " & song)
It prints two random cells between row 1 and row 195 from the Excel sheet "Music". One of them - the one in column A - represents the album, and the other represents the song. The problem is that it takes quite a long time to return the results, about 20 seconds.
I was wondering whether there was a more efficient method I could use to get the results more quickly.
I think Ansgar Wiechers' answer is probably correct that starting Excel is the slowest part of the script. You could try using ADO to connect to the Excel file as if it were a database. This would avoid starting Excel:
Option Explicit
Randomize
Dim conn, rst, song, album
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Users\Name\Documents\Music.xlsx;" & _
"Extended Properties='Excel 12.0 Xml;HDR=NO';"
' Select a random record; reference https://stackoverflow.com/a/9937263/249624
' Asc(album) is just a way to get some numeric value from the existing data
Set rst = conn.Execute("SELECT TOP 1 F1 AS album, F2 as song FROM [Sheet1$] ORDER BY Rnd(-(100000*Asc(F1))*Time())")
If rst.EOF Then
song = "[NO RECORDS]"
album = "[NO RECORDS]"
Else
song = rst("song").Value
album = rst("album").Value
End If
MsgBox("Album name: " & album & vbNewLine & "Song name: " & song)
The one possible snag here is that VBScript is run by default using the 64-bit version of wscript.exe, and the 64-bit ACE.OLEDB is only available if you installed the 64-bit version of Office 2010 or higher. This can be worked around, though, by running the script with the 32-bit version of wscript.exe (e.g., see How do I run a VBScript in 32-bit mode on a 64-bit machine?).
If you decide to go this route and can control the input Excel file, I would recommend adding a header row to the spreadsheet and changing HDR=NO to HDR=YES in the connection string. That way, you can refer to the columns by name in the query (e.g., SELECT TOP 1 album, song ...) instead of relying on the "F1" syntax.
The most time-consuming steps in your script are most likely
starting Excel and
opening the workbook.
One thing you could do is using an already running Excel instance instead of creating a new one all the time:
quitExcel = False
On Error Resume Next
Set objApp = GetObject(, "Excel.Application")
If Err Then
Set objApp = CreateObject(, "Excel.Application")
quitExcel = True
End If
On Error Goto 0
The variable quitExcel indicates whether you need to close Excel at the end of your script (when you created a new instance) or not (when you used an already running instance).
You could also check if the workbook is already open:
wbOpen = False
For Each wb In objWbs
If wb.Name = "Music.xlsx" Then
Set objWorkbook = wb
wbOpen = True
Exit For
End If
Next
If Not wbOpen Then
Set objWorkbook = objWbs.Open("C:\Users\Name\Documents\Music.xlsx")
End If
Other than that your only options are changing the way the data is stored or buying faster hardware, AFAICS.
Cheran, I disagree with the answers here.
I just ran your script on my 5 year old laptop, and got the answer in about 2 seconds. Whether an instance of Excel was already open made no difference in run time.
(I created a test Music.xlsx spreadsheet by entering "A1" in cell A1, and "B1" in cell B1, and dragged those cells down to row 195 to get a nice set of unique sample data).
Why don't you make Excel visible when it runs, so that you can see for yourself what is going on?
You might see, for example, that Excel takes one second to open, and the Excel Add-ins you have are taking the other fifteen seconds to initialize. It's also possible that your machine and/or hard drive is slow and does indeed take 20 seconds to run this. Who knows...
To get some insight, please make objApp.Visible = True and rerun.
You might also comment out the final eight lines, except for the MsgBox line so that your Excel file stays open after script is done, so that you might see other clues.
Other observations:
1) Your method of opening Excel with CreateObject from a .vbs script seems to be the most reliable/accepted method of automating Excel.
2) It's not stated here HOW you are running the .vbs script (command line vs. double-click from Explorer). Your script is running, but be aware that using cscript.exe to run the .vbs is also common when people try to automate this.
3) I'm not used to seeing an external vbs interact with the data inside Excel...I'm used to having vbs open Excel.xlsm, then letting a Macro do the number crunching. But, Macros bring an entirely different set of headaches. I'm not saying your method is good or bad...just not used to that approach.
Good luck!
Related
I've already read in the forums but noone has my exactly problem, so here we go.
I have my excel and powerpoint files in a OneDrive folder (the Powerpoint is in subfolder), the powerpoint has 100 links.
So, in a forum someone suggested that to get the local OneDrive path, you should turn off the process. I did it.
I have to have the excel file open, because the processing time is really slow if the excel is closed. So If I have opened the excel file and run the macro (in other folder diferent to OneDrive) it runs ok, but if I try to do the same but in the OneDrive folder, it generated the next error into the code line pptShape.LinkFormat.Update:
Error -2147188160 (80048240) in runtime. LinkFormat (unknown member):
Invalid request. The linked file was unavailable and could not be
updated
If I have the excel file closed, the macro runs ok, but the process is so slow (almost 30 minuts), because it open and close the excel a hundred times.
does anyone knows why it happened? How can I fix it? I'll appreaciate your help. here is the code to update the links
Sub updatelinks_1()
Call Shell("cmd.exe /S /C" & "%LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /shutdown")
Application.DisplayAlerts = ppAlertsNone
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
'Set the variable to the PowerPoint Presentation
Set pptPresentation = ActivePresentation
'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides
'Loop through each shape in each slide
For Each pptShape In pptSlide.Shapes
'Find out if the shape is a linked object or a linked picture
If pptShape.Type = msoLinkedOLEObject Then
Dim name, path1, path2, source, begin, search1, cells As String
Dim limit1 As Integer
name = pptShape.LinkFormat.SourceFullName
limit1 = InStr(1, name, "!")
cells = Right(name, Len(name) - limit1)
search1 = "subfoldername"
path1 = Application.ActivePresentation.FullName
begin = InStr(1, path1, search1)
begin = Left(path1, begin - 1)
file1 = Dir(begin & "*.xlsm")
source = begin & file1
End If
path2 = source & "!" & cells
pptShape.LinkFormat.SourceFullName = path2
'update method. code line where generate error
pptShape.LinkFormat.Update
End If
Next
Next
'Update the links (If I use this method on OneDrive folder, it doesn't work and broke all the links because replace the Link name with only the excel file name, not the sheets and cells)
' pptPresentation.UpdateLinks
Call Shell("cmd.exe /S /C" & "start %LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /background")
Set pptPresentation = Nothing
Set pptSlide = Nothing
Set pptShape = Nothing
Application.DisplayAlerts = ppAlertsAll
End Sub
Good morning everyone.
As I have not seen the solution, I'd like to add my 2 cents.
I have had a similar issue, on a win10 Platform running Office 365.
In my case both files are on the same laptop.
I have seen that the powerpoint VBA procedure to update the path takes a long time by default. ( around 4 Minutes for me as there are 22 linked Objects).
One can speed it up by manually open the target excel file before launching the Powerpoint VBA.
It becomes effectively faster but I hit the issue where for each link the ppt vba procedure tries to update, we get a pop up window telling us that Excel can't open 2 files with same name.
I've tried to add in the PowerPoint VBA procedure : Application.DisplayAlerts = False , but is logically inefficient as applies to the PPT application and not to the Excel app !
I finally found one quick (and logic) solution :
at the beginning of the PowerPoint VBA, I ask user to locate the target excel file :
Set XlApp = CreateObject("Excel.Application")
ExcelFile = XlApp.GetOpenFilename(, , "Would you please locate your excel File")
And after, I just Open the target file, and set it with displayLAerts to False.
XlApp.Visible = True
Set xlWorkbook = XlApp.Workbooks.Open(ExcelFile, True, False)
Doing so, I no longer get warnings.
Full source code available .
Wish you a nice day !
I have been working with this issue for days. I tried multiple different ways. I am attempting to append multiple files into an Access linked table or even a temp table or even into a single excel file. At first EVERY SINGLE TIME on the first attempt the program works perfectly, then after that it stops functioning for a period of time and then starts operating again. When it stop functioning I get an Subscript out of range run-time error 9.I open the proper excel file but for some reason it won't let me set it... How can it OPEN THE FILE but in the next line CAN'T FIND IT??? It is driving me insane, it works, it stops working, then it works again... Any advice or hints would be very much appreciated.
This is just one way I tried to do this but they all end the same.
i = 2 'i is created through another loop previously.
j = 0
With MyXL
.Visible = True
.DisplayAlerts = True
End With
Do
Set MyXL = CreateObject("Excel.Application")
MyXL.Workbooks.Open Directory & fileArray(j), Notify:=False, ReadOnly:=False 'Tried True previously but changed since i was making changes to the file.
Set wb = Workbooks(fileArray(j)) 'DING DING DING!!! WHY??? You WORKED before!!!
If wb.Sheets("Sheet1").Range("A1") = "System Status" Then
wb.Sheets("Sheet1").Range("A1") = "PO System Status"
wb.Save
End If
wb.Close True
Set wb = Nothing
MyXL.Quit
Set MyXL = Nothing
Set wb = Nothing
j = j + 1
Loop Until j = i
Previously I thought I wasn't closing the workbook correctly, but I have closed the MyXL and previous wb but i still run into the error. I was wondering if this is something that Access/vba just can't do in succession as well. I changed the ReadOnly to true and it still ends up the same way.
Set your workbook to the return value from the Open method:
Set wb = MyXL.Workbooks.Open(Directory & fileArray(j), Notify:=False, ReadOnly:=False)
If wb.Sheets("Sheet1").Range("A1") = "System Status" Then
wb.Sheets("Sheet1").Range("A1") = "PO System Status"
wb.Save
End If
You don't need to/shouldn't create a new Excel application instance for every file - set that up before you enter the loop, and close it once you're done updating files. Check your Task Manager and make sure you don't have a bunch of Excel instances hanging around.
Working on automating a mail merge using Excel as the data source and merging into multiple .doc files as templates.
The first pass works great! Here is an outline of how the code is supposed to work:
1) Data is pulled from SQL Server into Excel and saved as .xlsx on a network drive.
2) Excel sheet is attached as a datasource to the .doc file and the merge is executed successfully.
3) xlWorkbook.Close(), xlApp.Workbooks.Close(), and xlApp.Quit(). Then I call my garbage collection routine to release the COM objects using Marshal.ReleaseComObject, and it appears Excel closes properly.
4) Use the same Excel source file with different template to create the next batch of letters.
At this point it seems the Excel file isn't releasing from memory after previously being used as a datasource. When I use wdAffDoc.MailMerge.OpenDataSource, I get a popup window from Word asking me which table to use and the list of tables is blank. The source data spreadsheet is NOT listed in the "spreadsheet" window of the popup. Last time I had this issue it was because I had the source file open on a different machine, and it wouldn't merge due to the lock. When this code bombs out, I look in Task Manager and see 1 or sometimes 2 entries of "EXCEL.EXE *32" listed under my username. The code will not run until the remaining EXCEL.EXE *32 processes are terminated.
Looking for any input as to the direction I should go here. Should I suspect my garbage collection routine, or do you think it's something else?
Here is my garbage collection:
Public Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
MsgBox(ex.Message)
Finally
GC.Collect()
End Try
End Sub
Here is the first pass after pulling the source data (works as expected):
frmPleaseWait.Label1.Text = "Now merging documents. Please wait."
frmPleaseWait.Refresh()
Dim wdApp As New Word.Application
Dim wdDoc As New Word.Document
'Select template based on Queue chosen
If Queue = "716" Then
wdDoc = wdApp.Documents.Open("X:\Admin\LEGAL\MERGE LETTERS\UPH Vfn 2 Def.doc")
End If
wdApp.Visible = False 'Set this to False before going live -- true for debugging
wdDoc.MailMerge.OpenDataSource(Name:=fileDest, SQLStatement:="SELECT * FROM [Sheet1$]") 'Add a WHERE clause for filtering for affidavits, etc.
'.Destination 0 = DOCUMENT, 1 = PRINTER
wdApp.ActiveDocument.MailMerge.Destination = 0 'send to new document
With wdApp.ActiveDocument.MailMerge.DataSource
.FirstRecord = 1 'wdDefaultFirstRecord
.LastRecord = -16 'wdDefaultLastRecord
End With
wdApp.ActiveDocument.MailMerge.Execute(Pause:=False)
wdDoc.Close(SaveChanges:=False) 'Close the original mail-merge template file
wdApp.ActiveDocument.SaveAs2(savePath & "\" & ProcessDate & " " & Queue & " Verifications.doc")
wdApp.Quit()
wdDoc = Nothing
wdApp = Nothing
And here is the second (offending) pass:
Dim wdAffApp As New Word.Application
Dim wdAffDoc As New Word.Document
If Queue = "716" Then
wdAffDoc = wdAffApp.Documents.Open("X:\Admin\LEGAL\MERGE LETTERS\Suit Affidavit 2 Def.doc")
End If
wdAffApp.Visible = False 'Set this to False before going live -- true for debugging
'****************THIS IS THE LINE THAT PRODUCES THE ERROR****************
wdAffDoc.MailMerge.OpenDataSource(Name:=fileDest, SQLStatement:="SELECT * FROM [Sheet1$] WHERE [Suit_Bal] >= 5000") 'Add a WHERE clause for filtering for affidavits, etc.
'************************************************************************
'.Destination 0 = DOCUMENT, 1 = PRINTER
wdAffApp.ActiveDocument.MailMerge.Destination = 0 'send to new document
With wdAffApp.ActiveDocument.MailMerge.DataSource
.FirstRecord = 1 'wdDefaultFirstRecord
.LastRecord = -16 'wdDefaultLastRecord
End With
wdAffApp.ActiveDocument.MailMerge.Execute(Pause:=False)
wdAffDoc.Close(SaveChanges:=False) 'Close the original mail-merge template file
wdAffApp.ActiveDocument.SaveAs2(savePath & "\" & ProcessDate & " " & Queue & " Affidavits.doc")
wdAffApp.Quit()
wdAffDoc = Nothing
wdAffApp = Nothing
'Signal the end
frmPleaseWait.Dispose()
MsgBox("Mail merge complete")
Apparently my code worked!
After reviewing further, I discovered there was still WINWORD.EXE *32 running in the task manager. When I switched to that application, a popup window asked me if I wanted to save or delete the recovered files... must have been an error from one of my prior runs that got stuck in memory. Once I told Word to drop the recovered files, the code completes as expected. Whew! Glad this one is solved!
I'm creating a script in HP UFT 12 which performs grid data validation against a CSV file and saves the results in a Excel file with two worksheets.
I'm using Excel for this because it is much more clear for the user, as it allows cell formatting, is easier to compare the data and so forth.
My code works in my machine, but my client has TITUS document classification add-in installed, so every time they run my script, it hangs because of the TITUS pop-up message that asks user to classify the document upon saving. The message is not displayed to the user, probably because of objExcel.DisplayAlerts = False, but the script does not move forward.
Following is the portion of my code which is related to the matter (I have omitted most of the code, for confidentiality reasons).
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
Dim objWorkbook : Set objWorkbook = objExcel.Workbooks.Add
objExcel.Visible = False
Dim wsGrid : Set wsGrid = objWorkbook.Worksheets(1)
wsGrid.Name = "Grid Data"
Dim wsExported : Set wsExported = objWorkbook.Worksheets.Add
wsExported.Name = "Exported Data"
' Internal code to perform validation and fill worksheets ...
objExcel.DisplayAlerts = False
objWorkbook.SaveAs "C:\my_folder_path\my_file_name.xls" ' This is where it hangs in machines where the add-in is installed
objWorkbook.Close
objWorkbook.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
I have searched online but haven't find anything related to it so far. I did find this and this, but they are related to TITUS for Outlook and in neither one the issue is properly solved.
Does anyone know how to solve this, or can point me to a research material to help me solve this issue?
Thanks in advance.
As ridiculously simple as it looks (I don't know how I haven't thought of this before), I manage to solve my issue by simply adding objExcel.EnableEvents = False before saving the file:
objExcel.DisplayAlerts = False
objExcel.EnableEvents = False ' this is the problem solver for the matter!
objWorkbook.SaveAs "C:\my_folder_path\my_file_name.xls"
objExcel.EnableEvents = True ' Not sure if this statement is necessary, though
objWorkbook.Close
objWorkbook.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
So far as I can tell, none of the above answers actually classify the Excel workbook (and I found this on our work intranet having failed to find any code on the internet).
The code below should set Classification as Internal which can be amended as you need, and will also create the footer text based on 'ClassificationVal'.
Code then sets the classification, adds the left footer and removes the annoying page breaks at the same time (note: setting classification automatically sets page breaks).
Disabling events before save seems to be the only way to avoid the pop up box...
Note: you will need to replace '[Company Name]-' with e.g. 'IBM-' (if your company adds it's name to the classification, and delete '[Company Name]-' if they use the TITUS classification only. Also, the classifications seem to be bespoke to each company from my experience, so you may need to update accordingly.
ClassificationVal = "[Company Name]-1nternal"
ClassificationDesc = "[Company Name]: "
ClassificationDesc2 = ""
Select Case ClassificationVal
Case "[Company Name]-1nternal"
ClassificationDesc2 = "Internal"
Case "[Company Name]-pub1ic"
ClassificationDesc2 = "Public"
Case "[Company Name]-Confidentia1"
ClassificationDesc2 = "Confidential"
Case "[Company Name]-5ecret"
ClassificationDesc2 = "Secret"
Case "[Company Name]-pr1vate"
ClassificationDesc2 = "Private"
End Select
If ClassificationDesc2 = "" Then Stop
ClassificationDesc = ClassificationDesc & ClassificationDesc2
With ActiveWorkbook.CustomDocumentProperties
.Add Name:="[Company Name]Classification", _
LinkToContent:=False, _
Type:=msoPropertyTypeString, _
Value:=ClassificationVal
End With
For Each ws In ActiveWorkbook.Worksheets
ws.PageSetup.LeftFooter = ClassificationDesc
ws.DisplayPageBreaks = False
Next ws
Application.EnableEvents = False 'disable TITUS pop-up
ActiveWorkbook.SaveAs Filename:= _
"C:\Data\kelvinj\My Documents\TITUS Test.xlsx", 'Change to suite your requirements
FileFormat:=xlOpenXMLWorkbook _
, CreateBackup:=False
Application.EnableEvents = True
Not sure why this is so hard to find a solution to - this is the 2nd multinational company I've worked for to be infected by TITUS, so there must be loads of people needing this code surely?!
I am not a VBA coder but my friends were working on this
The solution we found was on the behaviour of Titus
It will ask you to classify any new workbook when u save it. Note new not an already saved workbook.
So we created a blank workbook and saved it(with the required classification)
Amended the code to take that workbook and add data to it and using save as to create the required files
It works smoothly without any issues.
I have about 50 or so Excel workbooks that I need to pull data from. I need to take data from specific cells, specific worksheets and compile into one dataset (preferably into another excel workbook).
I am looking for some VBA so that I can compile the results into the workbook I am using to run the code.
So, one of the xls or xlsx files I need to pull the data from, worksheet("DataSource"), I need to evaluate cell(D4), and if its not null, then pull data from cell(F4), and put into a new row into the compiled data set. Looping through all the Excel files in that folder as mentioned above.
And if possible, I would like the first data field in the first column the name of the file the data is being pulled from in the resulting dataset.
Can someone help me with this? I am looking for VBA because I am more familiar with that, but also interested in VBScript (as I am trying to get into that and learn the differences).
First start with this google query and click the first link that comes up, which takes you to an article showing how to iterate through a group of Excel files in a folder.
Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\MyDocuments\TestResults"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
'.Filename = "Book*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'DO YOUR CODE HERE
wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
To get the name of the workbook, you'll want to adapt the code at "DO YOUR CODE HERE" to include wbResults.Name. If it's the filename you want, use wbResults.FullName, which returns the name of the workbook including its path on disk as a string.
A search for a VBScript variation on the same thing yields a number of results that are useful, including this script:
strPath = "C:\PATH_TO_YOUR_FOLDER"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
For Each objFile In objFolder.Files
If objFso.GetExtensionName (objFile.Path) = "xls" Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
' Include your code to work with the Excel object here
objWorkbook.Close True 'Save changes
End If
Next
objExcel.Quit
I would do it in VBScript or even, VB.NET or Powershell if you feel so inclined.
Using VB.NET, you can access Excel spreadsheets as if they were databases, via the OLEDB provider. The code to select a range of values might look like this :
Try
Dim MyConnection As System.Data.OleDb.OleDbConnection
Dim DtSet As System.Data.DataSet
Dim MyCommand As System.Data.OleDb.OleDbDataAdapter
MyConnection = New System.Data.OleDb.OleDbConnection _
("provider=Microsoft.Jet.OLEDB.4.0;" _
" Data Source='testfile.xls'; " _
"Extended Properties=Excel 8.0;")
MyCommand = New System.Data.OleDb.OleDbDataAdapter _
("select * from [Sheet1$]", MyConnection)
MyCommand.TableMappings.Add("Table", "TestTable")
DtSet = New System.Data.DataSet
MyCommand.Fill(DtSet)
MyConnection.Close()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
Once you get the data you can elaborate on it, then insert the result into another Excel spreadsheet, using the same API.
Getting the list of files is easy in .NET with a call to System.IO.Directory.GetFiles(); just specify the "*.xls" wildcard. Once you have the list, just use a for loop to iterate through it, opening each file in turn, then doing the query on that file, and so on.
If you use VBScript, then the preferred way to get the list of Excel files is to use the Scripting.FileSystemObject, specifically the GetFolder method. It works basically the same way but the syntax is slightly different.
If it's VBScript or VB.NET it will probably run outside of Excel itself. You'd run it by double-clicking or from a batch file or something like that. The advantage to using VB.NET is you could put up a graphical form for interaction - it could show a progress bar, tracking how many files you've gone through, status updates, that kind of thing.
Whenever you are accessing that many Excel files in succession, you can generally get better performance using ADODB rather than Excel's automation object.
I agree with using that accessing the Excel object is not the quickest and if the workbooks and sheets that you're trying to retrieve data from are all consistent (i.e have the same column names, etc... or at least the column names you're looking for) it would be better to use ODBC. This does have some issues and if you can't get around them or need to actually do something more complex based on the contents then there may be no way around it. If that's the case then I would suggest creating one Excel object and then opening and closing the files as needed to try to increase the efficiency.
It could be done with the following code
Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("V:\XX\XXX\*.xlsx")
Do While Len(StrFile) > 0
Debug.Print StrFile
Set wbResults = Workbooks.Open("V:\XX\XXX\" & StrFile)
'DO YOUR CODE HERE
wbResults.Close SaveChanges:=True
StrFile = Dir
Loop
End Sub