I want to extract several embedded Excel files in a Word document. I use this code which works:
Sub ExtractExcel()
Dim ExcelApp As Object
Dim ISh As InlineShape
Dim Path As String: Path = "C:\tmp\"
Dim Excel As Boolean: Excel = False
For Each ISh In ActiveDocument.InlineShapes
If ISh.Type = wdInlineShapeEmbeddedOLEObject Then
If InStr(LCase(ISh.OLEFormat.ProgID), "excel") > 0 Then
ISh.OLEFormat.Activate
If Not Excel Then Set ExcelApp = GetObject(, "Excel.Application")
Excel = True
If Dir(Path & ISh.OLEFormat.IconLabel) <> "" Then Kill Path & ISh.OLEFormat.IconLabel
ExcelApp.Workbooks(1).SaveAs Path & ISh.OLEFormat.IconLabel
ExcelApp.Workbooks(1).Close
End If
End If
Next
If Excel Then ExcelApp.Quit
End Sub
This procedure takes time because an Excel application is opened and it flashes for each file. Is there a way to speed up the extraction?
I tried to unzip the Word document and copy the Excel file from word/embeddings but the Excel file does not open.
I also tried to convert with ActiveDocument.InlineShapes(1).ConvertToShape ClassType:="Excel.SheetBinaryMacroEnabled.12" … the ole objects to a binary Excel format, I cut the ole-header from the unzipped files word/embeddings/oleObjectN.bin and renamed them properly. But again, the Excel files don’t open:
Is there is any better (optimized) way?
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 !
My excel file is connected into the analysis services database. I want to auto refresh the excel and save it into my computer everyday even if I do not open the excel.
I am wondering how to do it.
The reason that I want to do it: Since it is connect to the database and it is only show the recent 5 weeks data and I want to save all the data every day so I can have historical data.
Please help if you know how to do thsi
What I want is excel file is auto saved into my computer,Desktop for example everyday even if I did not open it.
You can write a VBA macro (reuse what you have already written) and call it from Excel in a VBS script that it started by Windows Scheduler when you want.
My BAT file
::********************************************************************
::* Generate-Excel-File.bat
::********************************************************************
#echo ON
SETLOCAL ENABLEDELAYEDEXPANSION
C:\windows\syswow64\cscript.exe LoadExcel.vbs
My VBS file
'*****************************************************************************
'* LoadExcel.vbs
'*****************************************************************************
' Create a WshShell to get the current directory
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Create an Excel instance
Dim oExcel
Dim oWorkBook
Set oExcel = CreateObject("Excel.Application")
' Disable Excel UI elements
oExcel.DisplayAlerts = False
oExcel.AskToUpdateLinks = False
oExcel.AlertBeforeOverwriting = False
oExcel.FeatureInstall = msoFeatureInstallNone
' Tell Excel what the current working directory is
' (otherwise it can't find the files)
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = oExcel.DefaultFilePath
strPath = WshShell.CurrentDirectory
oExcel.DefaultFilePath = strPath
' Open the Workbook specified on the command-line
Set oWorkBook = oExcel.Workbooks.Open(strPath & "\US.TRACKING-FILE.NEW.xlsm")
' Build the macro name with the full path to the workbook
on error resume next
' Run the calculation macro
oExcel.Run "LoadCSV"
if err.number <> 0 Then
' Error occurred - just close it down.
End If
err.clear
on error goto 0
'oWorkBook.Save
'oExcel.DefaultFilePath = strSaveDefaultPath
' Clean up and shut down
Set oWorkBook = Nothing
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will
' shut those down also
if oExcel.Workbooks.Count = 0 Then
oExcel.Quit
End If
Set oExcel = Nothing
Set WshShell = Nothing
I hope that can help you to solve your problem.
In this example, I load a CSV file in Excel but if you want, you can run a SQL command in VBA and fill what you want using pure Excel macros.
I am trying to save an embedded OLE Object (Excel workbook) from my current/open workbook to a location on the user's PC. This OLE object is a template/dashboard that gets populated during the execution of the macro.
The macro first tests if the file exists on the user's C drive.
If it does exist, it opens that file and sets a workbook variable to this newly opened workbook. This works in both Excel 2010 and Excel 2013.
Where the user does NOT have the file saved to their C drive, the macro opens the OLE object to save it to drive. The macro then points back to that location and opens the file. The code works in Excel 2013, however in Excel 2010, the macro crashes Excel when I try to save the file to the drive. If I run the macro in break mode, saving works, it is only during run-time that there is a crash.
Could there be a possible use of DoEvents or Application.Wait here?
Some things that I've noticed:
The crash does not generate any error code. It simply gives "Has stopped responding".
I've tried multiple versions of .SaveAs fileformat:=52 vs .SaveCopyAs. Both methods produce the same crash in 2010.
The OLE object opens as "Worksheet in", it would be nice if this opens in a new workbook. I'm thinking this crash could be related to how the object is opened as a "Worksheet in" rather than it's own workbook.
Code:
Dim uName As String
Dim fName As String
Dim wbk As Workbook
Dim sumWB as Workbook
Dim cbrWB as Workbook
Set cbrWB = Workbooks("PreviouslySet")
uName = Left(Environ("AppData"), Len(Environ("AppData")) - 16)
fName = uName & "\OTPReport" & ".xlsm"
If Dir(fName) = "" Then
Set oEmbFile = cbrWB.Worksheets("CBRDATA").OLEObjects("OTPReport")
oEmbFile.Verb 0
For Each wbk In Workbooks
If InStr(1, wbk.Name, "Worksheet in", vbTextCompare) > 0 And InStr(1, wbk.Name, Left(cbrWB.Name, Round(Len(cbrWB.Name) / 2)), vbTextCompare) > 0 Then
Set sumWB = Workbooks(wbk.Name)
End If
Next wbk
With sumWB
.Activate
.Application.DisplayAlerts = False
'==ISSUE EXISTS HERE==
.SaveCopyAs (fName)
.Close
End With
Set sumWB = Nothing
Set sumWB = Workbooks.Open(fName)
Else:
Set sumWB = Workbooks.Open(fName)
End If
Use the actual embedded COM object instead of the default action that .Verb 0 gives you.
OLEObjects expose a reference to the underlying object if they are being administered by a COM server (it's the .Object property). In your case, since you have an embedded workbook, it's just a Workbook object like any other Workbook object you'd encounter in VBA. All you should need to do is call .SaveAs on it:
oEmbFile.Object.SaveAs fName
Then you can simply skip the rest of the gymnastics related to trying to find it in your current Excel server.
Posting my solution here to show what seems to be working in both 2010 and 2013. This solution was developed with the help of user COMIntern. I will give credit for this solution to his answer.
Updated code w/ explanation:
Dim uName As String
Dim fName As String
uName = Left(Environ("AppData"), Len(Environ("AppData")) - 16)
fName = uName & "\OTPReport" & ".xlsm"
If Dir(fName) = "" Then
Set oEmbFile = cbrWB.Worksheets("CBRDATA").OLEObjects("OTPReport")
oEmbFile.Object.SaveAs fName
'For some reason a new workbook named "BookN" (n = to some integer) is created when
'saving our embedded file to C. To counter this, I close the most recently opened workbook.
Workbooks(Workbooks.Count).Close
'When opening this workbook, the file shows that it is opened, but the window is not activated.
'We must use the name of the file and call activate to get it to show up in our active windows.
Set sumWB = Workbooks.Open(fName)
Windows("OTPReport.xlsm").Activate
Else:
'same explanation as above
Set sumWB = Workbooks.Open(fName)
Windows("OTPReport.xlsm").Activate
End If
I am working on linking charts in powerpoint (ppt) slides to charts in Excel (xls) workbooks. This works fine without vba code, as I just use paste special to create a link. The problem is however when I change the directoy of the ppt as well as the xls, as the ppt will still try to update the data from the xls in the old directory. My goal however would be to share these files, so everyone can just update their ppt with their xls.
So, to put it shortly, I want to update the ppt, but choose a different workbook (with a different directory). This workbook will be identical to the old one in terms of structure, just with diffeerent data.
I know there is the method updatelinks, but there doesn't seem to be any way to choose a different directory with this method. Does anyone have any tips?
So, to put it shortly, I want to update the ppt, but choose a different workbook (with a different directory). This workbook will be identical to the old one in terms of structure, just with different data.
TRIED AND TESTED with MS-OFFICE 2010
I have commented the code so that you will not have a problem understanding it. If you still do then feel free to ask.
Option Explicit
Sub UpDateLinks()
'~~> Powerpoint Variables/Objects
Dim ofd As FileDialog
Dim initDir As String
Dim OldSourcePath As String, NewSourcePath As String
'~~> Excel Objects
Dim oXLApp As Object, oXLWb As Object
'~~> Other Variables
Dim sPath As String, OldPath As String, sFullFileOld As String
Dim oldFileName As String, newFileName As String
'Set the initial directory path of File Dialog
initDir = "C:\"
'~~> Get the SourceFullName of the chart. It will be something like
' C:\MyFile.xlsx!Sheet1![MyFile.xlsx]Sheet1 Chart 1
OldSourcePath = ActivePresentation.Slides(1).Shapes(1).LinkFormat.SourceFullName
Set ofd = Application.FileDialog(msoFileDialogFilePicker)
With ofd
.InitialFileName = initDir
.AllowMultiSelect = False
If .Show = -1 Then
'~~> Get the path of the newly selected workbook. It will be something like
' C:\Book2.xlsx
sPath = .SelectedItems(1)
'~~> Launch Excel
Set oXLApp = CreateObject("Excel.Application")
oXLApp.Visible = True
'~~> Open the Excel File. Required to update the chart's source
Set oXLWb = oXLApp.Workbooks.Open(sPath)
'~~> Get the path "C:\MyFile.xlsx" from
'~~> say "C:\MyFile.xlsx!Sheet1![MyFile.xlsx]Sheet1 Chart 1"
OldPath = Split(OldSourcePath, "!")(0)
'~~> Get just the filename "MyFile.xlsx"
oldFileName = GetFilenameFromPath(OldPath)
'~~> Get just the filename "Book2.xlsx" from the newly
'~~> Selected file
newFileName = GetFilenameFromPath(.SelectedItems(1))
'~~> Replace old file with the new file
NewSourcePath = Replace(OldSourcePath, oldFileName, newFileName)
'Debug.Print NewSourcePath
'~~> Change the source and update
ActivePresentation.Slides(1).Shapes(1).LinkFormat.SourceFullName = NewSourcePath
ActivePresentation.Slides(1).Shapes(1).LinkFormat.Update
DoEvents
'~~> Close Excel and clean up
oXLWb.Close (False)
Set oXLWb = Nothing
oXLApp.Quit
Set oXLApp = Nothing
End If
End With
Set ofd = Nothing
End Sub
Public Function GetFilenameFromPath(ByVal strPath As String) As String
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = _
GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
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