I am trying to read data from several shared Excel documents without opening them. They are all in the same network directory except for the file I have written.
This is a sample of the data I am pulling:
=SUMPRODUCT(COUNTIFS('[Tracker_v1.2.xlsm]Work Log'!$D:$D,B5,'[Tracker_v1.2.xlsm]Work Log'!$J:$J,{"XXXX","YYYY"}))
=SUMPRODUCT(COUNTIFS('[B Tracker_v1.1.xlsm]Work Log'!$D:$D,B6,'[B Tracker_v1.1.xlsm]Work Log'!$J:$J,{"XXXX","YYYY"})+COUNTIFS('[A Tracker_v1.1.xlsm]Work Log'!$D:$D,B6,'[A Tracker_v1.1.xlsm]Work Log'!$J:$J,{"XXXX","YYYY"}))
I have tried using file paths '\\network path\[A Tracker_v1.1.xlsm]Work Log'!
Is there a way to read data without manually opening documents?
Since you don't want to open the files manually, I suspect you might accept to open them automatically. Here's a straightforward example on how to open and close some files and perform calculations using VBA. You will still technically open the files but only for a short moment, and without actually displaying them. For the sake of illustration, assume you have two files FileA.xlsm and FileB.xlsm in the folder "C:\MyPath\" with the following data in range A1 to A3:
FileA FileB
1 4444
22 55555
333 666666
The following code will print the sum of each column in the immediate window.
Sub OpenClosedFiles()
' Opens some files, does some calculations and then closes those files.
Application.ScreenUpdating = False ' Hide the files during the microseconds while they're open.
' Define the path:
Const sPath As String = "C:\MyPath\" ' <--- Replace; don't forget the last backslash.
Dim rngA, rngB As Range
Dim sFileA, sFileB As String
Dim wbA, wbB As Workbook
sFileA = "FileA.xlsm"
sFileB = "FileB.xlsm"
Set wbA = Workbooks.Open(sPath & sFileA)
Set wbB = Workbooks.Open(sPath & sFileB)
Set rngA = wbA.Worksheets(1).Range("A1:A3")
Set rngB = wbB.Worksheets(1).Range("A1:A3")
' Do calculations on the ranges here, for example:
Debug.Print "Sum of FileA: " & Application.WorksheetFunction.Sum(rngA)
Debug.Print "Sum of FileB: " & Application.WorksheetFunction.Sum(rngB)
wbA.Close
wbB.Close
Application.ScreenUpdating = True
End Sub
You can use ADO and the Excel ODBC driver to treat closed workbooks as databases. You can then use SQL to retrieve data. But it assumes that you have information laid out in tables with table headings. AFAIK that's the only way to deal with a spreadsheet without opening it.
There's a walk through here
Would it work to link to the closed files? (In Excel 2016, click Data > Get Data > From File > From Workbook.) Then the VBA code would be only ActiveWorkbook.RefreshAll.
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 !
The following code is intended to update Word bookmarks with formatted data from Excel, however the formatting doesn't come across and unsure why, would appreciate any suggestions. The formatted data is text with certain works underlined.
Set wb = ActiveWorkbook
TodayDate = Format(Date, "mmmm d, yyyy")
Path = wb.Path & "\update_file.docx"
'Create a new Word Session
Set pappWord = CreateObject("Word.Application")
'Open document in word
Set docWord = pappWord.Documents.Add(Path)
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName).Text
End If
Next xlName
Try this instead, using Copy and the (poorly-documented) ExecuteMso method. You need to use Copy against the range (in order to capture formatting) and then you can effectively do the same as the right-click Paste + Keep Source Formatting option:
If docWord.Bookmarks.Exists(xlName.Name) Then
xlName.RefersToRange.Copy
docWord.Bookmarks(xlName.Name).Select
docWord.Application.CommandBars.ExecuteMso "PasteSourceFormatting"
End If
Alternatively, and this might be better because ExecuteMso is asynchronous and can result in timing issues:
xlName.RefersToRange.Copy
docWord.Bookmarks(xlName.Name).Range.PasteAndFormat 16 'wdFormatOriginalFormatting
I'm new to VBA, but learning. I've written most of the following code myself, some of it was inherited. My goal here is to loop through multiple text files (these each contain a unique set of raw data) and copy (or in some other way transfer) that data into an analysis template that I've made which will then be "saved as" with the same filename as the raw data text file. I've been working on this for several days and have done a significant amount of searching to get this far, however, I'm currently stuck with a "Run-time type '13' error - mismatch data type" that I don't understand so I don't know how to get past it. The error is # "Data.Sheets(Sheet1).Range("A1:G180000").Copy. If I comment out the aforementioned line and the one that follows it and use the line above ("Template.Sheets(Sheet1).Range("A1:G180000").Value...") I still get the same error. My code is posted below and any help is very much appreciated. Thanks :)
Sub Shift_Load_Data_Plotter_Template()
'Josh Smith
'12/27/2013
'Shift Load Data Plotter Template
'This macro will bring up the Open dialog box so you can open multiple text files and analyze them using the Shift Load Data Plotter Template
'Brings up the Open window so you can select multiple excel files to import
Dim fn As Variant, f As Integer
Dim FileName As String
'Data is the source workbook and Template is the destination workbook
Dim Data As Workbook
Dim Template As Workbook
fn = Application.GetOpenFilename("Text files,*.txt", _
1, "Select One Or More Files To Open", , True)
If TypeName(fn) = "Boolean" Then Exit Sub
'the line below was modified from from just "workbooks.open "Z:\..." to "Set Template = Workbooks.open..."
'opens the Shift Load Data Analyzer Template workbook and sets the "Template" variable equal to said workbook
Set Template = Workbooks.Open("Z:\General Reference, Tools\Shift Load Data Analyzer Template.xlsx")
For f = 1 To UBound(fn)
'the line below was modified from just "workbooks.open fn(f)" to what it shows now
'sets the "Data" variable equal to the workbook which contains the data from the text file
Set Data = Workbooks.Open(fn(f))
FileName = ActiveWorkbook.Name
'Data.Activate
'Template.Sheets(Sheet1).Range("A1:G180000").Value = Data.Sheets(Sheet1).Range("A1:G180000").Value
Data.Sheets(Sheet1).Range("A1:G180000").Copy
Template.Sheets(Sheet1).Range("A1").PasteSpecial (xlPasteValues)
'the line below used to be "ActiveWorkbook.SaveAs..."
Template.SaveAs FileName:="Z:\" & FileName & ".xlsx"
Data.Close
Next f
End Sub
The line:
Data.Sheets(Sheet1).Range("A1:G180000").Copy
Should probably read as follows:
Data.Sheets("Sheet1").Range("A1:G180000").Copy
You need quotation marks around the sheet name if you're referring to the name (the Sheets() function is looking for the sheet name you see on the tab in Excel, not the Sheet1, Sheet2, Sheet3, etc. you see in the VBA screen). Otherwise you could write it like this:
Data.Sheet1.Range("A1:G180000").Copy
Try changing it to:
Data.Sheets(1).Range("A1:G180000").Copy
Template.Sheets(1).Range("A1").PasteSpecial (xlPasteValues)
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
I often use Excel with pivot tables based on .cub files for OLAP-type analysis. This is great except when you want to move the xls and you realise internally it's got a non-relative reference to the location of the .cub file. How can we cope with this - ie make it convenient to move around xls files that depend on .cub files?
The best answer I could come up with is writing a macro that updates the pivot tables' reference to the .cub file location....so I'll pop that in an answer.
Here's the macro I ended up with. Clearly this makes some assumptions that might not be right for you, e.g. it updates all pivot tables in the workbook to use the same .cub file.
It loops through the workbook's Pivot Table connections to use a .cub file with
the same name as this .xls file, in the same directory. This assumes that the PivotCaches are not using LocalConnections - check that ActiveWorkbook.PivotCaches(1).UseLocalConnection = False.
Sub UpdatePivotTableConnections()
Dim sNewCubeFile As String
sNewCubeFile = ActiveWorkbook.Path & Replace(ActiveWorkbook.Name, ".xls", ".cub", , , vbTextCompare)
Dim iPivotCount As Integer
Dim i As Integer
iPivotCount = ActiveWorkbook.PivotCaches.Count
' Loop through all the pivot caches in this workbook. Use some
' nasty string manipulation to update the connection.
For i = 1 To iPivotCount
With ActiveWorkbook.PivotCaches(i)
' Determine which cub file the PivotCache is currently using
Dim sCurrentCubeFile As String
Dim iDataSourceStartPos As Integer
Dim iDataSourceEndPos As Integer
iDataSourceStartPos = InStr(1, .Connection, ";Data Source=", vbTextCompare)
If iDataSourceStartPos > 0 Then
iDataSourceStartPos = iDataSourceStartPos + Len(";Data Source=")
iDataSourceEndPos = InStr(iDataSourceStartPos, .Connection, ";", vbTextCompare)
sCurrentCubeFile = Mid(.Connection, iDataSourceStartPos, iDataSourceEndPos - iDataSourceStartPos)
' If the PivotCache is using a different cub file then update the connection to use the new one.
If sCurrentCubeFile <> sNewCubeFile Then
.Connection = Left(.Connection, iDataSourceStartPos - 1) & sNewCubeFile & Right(.Connection, Len(.Connection) - iDataSourceEndPos + 1)
End If
End If
End With
Next i
End Sub