GetObject not unloading from VBA Project Window - vba

I have the following VBA code
Sub test2()
Set xlobj = GetObject("C:\Users\osknows\Desktop\One of each\Jan_2011.xls")
With xlobj
For Each wsobj In .Worksheets
Set rngobj = wsobj.UsedRange
arrArray = rngobj.Value
Next
End With
Erase arrArray
Set rngobj = Nothing
Set xlobj = Nothing
End Sub
The problem is that once this runs and exits the sub the Jan_2011.xls details are still in the VBA project window. I would expect this to disappear by setting xlobj = Nothing
Any ideas?

The line containing GetObject does two things: it opens the workbook and makes xlobj a reference to the workbook. When xlobj is set to nothing, the reference is cleared, but the workbook is still open. This can be avoided by adding the line
xlobj.Close
before emptying the variables.

Related

VBA macro runs on one computer but not on the other

I have a macro that runs fine on my computer, but when I put this macro on another computer it does not even allow to run in debug mode. It just crashes the MS Project saying that it stopped working.
Edit:
The crash comes from the following Set. I have already tried early binding as well Dim xlApp as Excel.Application but crashes anyway.
Dim xlApp As Object
Set xlApp = New Excel.Application
is there another way to set the xlApp as an Excel object?
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Try late binding the Excel object and remove the reference.
I'd suggest using Late Binding. As #Josh said - you'll need to remove your library references and update a substantial portion of your code.
Any constants that are specific to Excel will need updating to their numerical equivalent.
For example, when using PasteSpecial you'd use something like xlPasteValues.
Open the immediate window in Excel and enter ?xlPasteValues. This will return -4163 which is the number you must enter into your code in place of xlPasteValues.
Sub Test()
Dim oXL As Object
Dim oWrkBk As Object
Dim oWrkSht As Object
Set oXL = CreateXL
Set oWrkBk = oXL.Workbooks.Open("C:\Workbook1.xlsx")
Set oWrkSht = oWrkBk.worksheets("Sheet1")
With oWrkSht
.Range("A1").Copy
.Range("B1").PasteSpecial -4163 'xlPasteValues
End With
End Sub
Public Function CreateXL(Optional bVisible As Boolean = True) As Object
Dim oTmpXL As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Defer error trapping in case Excel is not running. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Set oTmpXL = GetObject(, "Excel.Application")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'If an error occurs then create an instance of Excel. '
'Reinstate error handling. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Err.Number <> 0 Then
Err.Clear
On Error GoTo ERROR_HANDLER
Set oTmpXL = CreateObject("Excel.Application")
End If
oTmpXL.Visible = bVisible
Set CreateXL = oTmpXL
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure CreateXL."
Err.Clear
End Select
End Function
please try this, just to see if it also crashes.
it creates the word object, then excel object and exits. each time it creates the object, it dispays the object name.
i am assuming that you also have msword installed
note: if you ever copy code from a web page, make sure that the quotation marks are correct. there appear to be several versions of quotation marks (opening quotes, closing quotes), and these are not valid in VBA
Sub test()
Dim myApp As Object
Set myApp = CreateObject("Word.Application")
MsgBox myApp.Name
Set myApp = CreateObject("Excel.Application")
MsgBox myApp.Name
Set myApp = Nothing
End Sub

Error Getting .OLEFormat.Object property of PowerPoint Shape (LateBinding from Excel-VBA)

I have an Excel VBA tool, that resides inside a PowerPoint Presentaion as an EmbeddedOLEObject.
Process work-flow:
A user opens the PowerPoint.
Then opens the Excel embedded object in it.
Running the code in it updates data in the Excel file, and then exports it to the 1st slide of the PowerPoint it was opened from.
The problem starts when the user opens 2 of these PowerPoint presentations. If you open one Presnetation, let's call it "P1", then you open a second presentation "P2". Then you open the embedded Excel file in "P2", the excel gets stuck. When running in debug mode, it goes "crazy" opening numerous VBA windows (without giving an error message), at the following line:
Set objExcel = myShape.OLEFormat.Object.
When running this process the other order, If first you open "P2", and then "P1", open the Embedded Excel file in "P2" it works well.
Anyone got a clue ?
Code
Option Explicit
Public Sub UpdatePowerPoint()
Dim ppProgram As Object
Dim ppPres As Object
Dim CurOpenPresentation As Object
Dim ppSlide As Object
Dim myShape As Object
Dim SlideNum As Integer
Dim objExcel As Object
Dim i As Long
On Error Resume Next
Set ppProgram = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If ppProgram Is Nothing Then
Set ppProgram = CreateObject("PowerPoint.Application")
Else
If ppProgram.Presentations.Count > 0 Then
' loop thorugh all open presentation, then loop through all slides
' check each object, check if you find an OLE Embedded object
For i = 1 To ppProgram.Presentations.Count
Set CurOpenPresentation = ppProgram.Presentations(i)
Set ppSlide = CurOpenPresentation.Slides(1) ' only check the first slide for Emb. Excel objects, otherwise not a One-Pager Presentation
For Each myShape In ppSlide.Shapes
Debug.Print myShape.Type & " | " & myShape.Name ' for DEBUG ONLY
If myShape.Type = 7 Then ' 7 = msoEmbeddedOLEObject
Dim objExcelwbName As String
' ***** ERROR in the Line below *******
Set objExcel = myShape.OLEFormat.Object
objExcelwbName = objExcel.CustomDocumentProperties.Parent.Name ' get's the workbook name of the Emb. Object
If objExcelwbName = ThisWorkbook.Name Then ' compare the name of the workbook the embedded object is in, with ThisWorkbook
Set ppPres = CurOpenPresentation
GoTo ExitPresFound
Else
Set objExcel = Nothing ' reset flag
End If
End If
Next myShape
NextPresentation:
Set CurOpenPresentation = Nothing ' clear presentation object
Next i
End If ' If ppProgram.Presentations.Count > 0 Then
End If
ExitPresFound:
If ppPres Is Nothing Then ' if One-Pager presentation was not found from all open presentations
MsgBox "Unable to Locate Presnetation, check if One-Pager Prsentation in Checked-Out (Read-Only Mode)"
End If
End Sub
Since the aim is to capture the presentation that hosts the embedded workbook, and as you confirmed that it looks to you as a good option, the suggested solution is the capture the ActivePresentation in the Workbook_Open event.
The risk that you raised is legitimate, it is possible (theoretically, I would say) that the impatient user switches presentations quickly before the workbook loads, but I could not test how likely is this scenario, due to some security alert in my test environment before the wb opens, giving a too large time for that action.
Awaiting your own confirmation :)

How to save an embedded Word document in an Excel workbook as a separate file using VBA

I am creating a workbook that will populate an embedded Word document template with pictures, and then save the document elsewhere, without editing the embedded template.
However, when I try to save the document, I get a Run-Time Error 4605 telling me:
"The SaveAs method or property is not available because this document is being edited in another applicator"
This is the sub to open the template:
Sub OpenWord()
'Opens the template when the main function first runs
Set WDObj = Sheets("Template").OLEObjects("Template")
WDObj.Activate
WDObj.Object.Application.Visible = False
Set WDApp = GetObject(, "Word.Application")
Set WDDoc = WDApp.ActiveDocument
End Sub
After this a main sub runs which populates the template, then when I try to save the document using:
WDDoc.SaveAs "myDocument.doc", FileFormat:=wdFormatDocumentDefault
I get the error.
Please has anyone encountered this error before/ know to to fix it, I have done much Googling which still has not gotten me anywhere.
I tested the following, which worked on my system/installation:
Sub OpenWord()
'Opens the template when the main function first runs
Dim WDObj As Object
Dim WDApp As Object
Set WDApp = GetObject(, "Word.Application")
Set WDObj = Sheets("Template").OLEObjects("Template")
WDObj.Activate
WDObj.Object.Application.Visible = False
WDApp.ActiveDocument.SaveAs ("YourFilename.doc")
Set WDObj = Nothing
Set WDApp = Nothing
End Sub

Calling VBA macro from .vbs file throws 800A03EC error

I'm trying to run a VBA macro through .VBS file(File name: Check_final.vbs). Here is the code
Option Explicit
run_macro
Sub run_macro()
Dim xl1
Dim sCurPath
Dim xlBook
Dim FolderFromPath
Set xl1 = CreateObject("Excel.application")
sCurPath =Wscript.ScriptFullName
Set xlBook = xl1.Workbooks.Open(sCurPath, 0, True)
xl1.DisplayAlerts = False
FolderFromPath = Left(sCurPath, InStrRev(sCurPath, "\"))
xl1.Application.run FolderFromPath & "Changed_chk.xlsm!Check"
Set xlBook = Nothing
End Sub
When I run this .vbs file I get this popup 'Changed_chk.xlsm is locked for editing' with Read only and notify options. If I acknowledge it with either Read only or notify option a excel sheet is opened in the name of Check_final (which is the file name of that .vbs file) and the above mentioned code is shown written in that excel file. Then I get a Windows script host error(code: 800A03AC) saying macro may not be available or all macro's are disabled.(Though I have enabled the macro as mentioned here.[http://www.addictivetips.com/windows-tips/enable-all-macros-in-excel-2010/)].
Any help on this is much appreciated. Thanks in advance.
You open your vbs-file instead of your excel-file... Also make sure that your function/sub is public. In the example below, I created a Public Sub Check in the module "YourModuleName", which I call from the vbs-file.
Option Explicit
run_macro
Sub run_macro()
Dim xl1
Dim xlBook
Dim FolderFromPath
Set xl1 = CreateObject("Excel.application")
FolderFromPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
set xlBook = xl1.Workbooks.Open(FolderFromPath & "Changed_chk.xlsm")
xl1.Application.run "'" & xlBook.Name & "'!YourModuleName.Check"
xl1.Application.Quit
End Sub
Try this simple code (UNTESTED)
Dim oXlApp, oXLWb, sCurPath
Set oXlApp = CreateObject("Excel.application")
sCurPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Set oXLWb = oXlApp.Workbooks.Open(sCurPath & "Changed_chk.xlsm")
oXlApp.DisplayAlerts = False
oXlApp.Run "Check"
'~~> Close the file here. Save or discard the changes as per your requirement
'oXLWb.Close (True)
'oXLWb.Close (False)
oXLWb.Close
oXlApp.Quit
Set oXLWb = Nothing
Set oXlApp = Nothing
Also where is your macro? In a sheet or in a module? You may want to see THIS
I think there may be something wrong with calling the run_macro statement. From the test i created in excel VBA there is an error if i try to call the sub outside of another sub
Option Explicit
test
Sub test()
MsgBox ("Test")
End Sub
I think you may want to
Option Explicit
Sub Start
run_macro
End Sub
Sub run_macro()
'code here
End Sub
or remove the run_macro line altogether?

Workbooks.Open returns different file than Filename

I am having the strangest problem. I was writing the below code on my laptop the other day and it worked fine. Now, I am testing it on my desktop and it's stopped working.
First, here's my code
Dim oApp As Application
Dim oWb As Workbook
Set oApp = New Application
oApp.Visible = True
Set oWb = oApp.Workbooks.Open(Filename:="C:\myFile.xlsx", ReadOnly:=True)
debug.print oWb.name
'returns "SOLVER.XLAM"
' "SOLVER.XLAM" is not "myFile.xlsx'
debug.print oApp.Workbooks.Count
'returns 1
debug.print oApp.Workbooks(1).name
'returns "myFile.xlsx"
Now, I know that solver is an add in, and it gets loaded in the new application upon creating it... but how does it perform this switcheroo? I can still get to the correct file, but I don't want to risk it on the coincidence that there is only 1 file in my Application object (or that the first file is the one I loaded)
Additional Info
I am calling executing this macro from within an excel instance and I wish to open a separate excel instance and then open particular workbook ("C:\myFile.xlsx") inside that other instance.
The key problem I'm having is that when I open the other instance and then add the workbook and set it to my oWb variable... somehow, when I later call that oWb variable it refers to something different from what I had set it to.
'This is how it makes me feel:
Dim x As Integer
x = 5
Debug.Print x
' 12
I think if you just refine your code a bit to ensure you are doing exactly what you want, you will be fine. Since it's unclear whether you are calling the code from within Excel or another MS Office Application, I placed to subs below.
Run this if running it in Excel:
Option Explicit
Sub insideXL()
Dim oWb As Workbook
Set oWb = Workbooks.Open("C:\myFile.xlsx", ReadOnly:=True)
Debug.Print oWb.Name
Debug.Print Workbooks.Count
Debug.Print Workbooks(1).Name
oWb.Close false
Set oWb = Nothing
End Sub
Run this if running in another program. I use early binding, but you could use late binding as well, if you wish:
Sub outsideXL()
'make sure Microsoft Excel X.X Object Library is checked in Tools > References
Dim oApp As Excel.Application
Set oApp = New Excel.Application
Dim oWb As Excel.Workbook
Set oWb = oApp.Workbooks.Open("C:\myFile.xlsx", ReadOnly:=True)
oApp.Visible = True
Debug.Print oWb.Name
Debug.Print Workbooks.Count
Debug.Print Workbooks(1).Name
oWb.Close = True
Set oWb = Nothing
Set oApp = Nothing
End Sub
I found that this (which worked in 2007):
wb = excel.Workbooks.Open(filename, False, True)
needs to be written
excel.Workbooks.Open(filename, False, True)
wb = excel.ActiveWorkbook
for 2010