I have this code I wrote in VBScript for wincc, and after running it the Excel application is still running, and the project is not working properly after this script. What can I do to close the Excel app?
Here is the script:
Dim fso
Dim rowcount
Dim ExcelObject
Dim WorkbookObject
Dim file
Dim i
Dim tg
Dim objSheet1
Dim objSheet2
'Set Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ExcelObject = CreateObject("Excel.Application")
file="C:\Parametri\Codificari.xls"
Set WorkbookObject = ExcelObject.Workbooks.Open(file)
'Set objSheet1 = WorkbookObject.Worksheets(1)
Set objSheet2 = WorkbookObject.Worksheets(2)
objSheet2.Cells(1,1)=SmartTags("locatie_defect")
If (fso.FileExists(file)) Then
'Raw numbering in Excel
rowcount = objSheet2.UsedRange.Rows.count
For i=3 To rowcount
tg="defect_"&i-2
SmartTags(tg)=objSheet2.Cells(i,2)
Next
End If
On Error Resume Next
'Save and close excel
ExcelObject.DisplayAlerts = False
ExcelObject.Workbooks.Close False
ExcelObject.Workbooks.Save
ExcelObject.Quit
On Error Resume Next
The standard way to close (sans error handling)
WorkbookObject.Save
WorkbookObject.Close False
ExcelObject.Quit
Set WorkbookObject= Nothing
Set ExcelObject = Nothing
Ensure all references are fully qualified, see here. On a quick look-over this doesnt jump out from your code.
For some reason Excel doesn't follow COM rules when used as an app object. No doubt for some compatibility reason.
It does follow COM rules as a doc object.
So Set WorkbookObject = GetObject("C:\Parametri\Codificari.xls") and now when it goes out of scope it will close as long as it's not visible. So just save it and it will close when your script ends. You probably only need half the lines you have.
Related
When I open Workbook and run this code everything is fine. Also if I close Workbook and open it again and run this code everything if functioning. However if I open Workbook and try to run this code for the second time then all Word operations are crushing. Word template is opened by code and even is saved to needed destination but it is not able to close Word document and gives an error:
Is there some variable or something in Windows memory still present after code has been executed because after closing and reopening Workbook everything works fine. Any ideas how to fix this?
Sub opentemplateWordOL()
Dim sh As Shape
Dim objWord As Object, objNewDoc As Object ''Word.Document
Dim objOL As OLEObject
Dim wSystem As Worksheet
'Application.ScreenUpdating = False
Set wSystem = ThisWorkbook.Sheets("Templates")
''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = wSystem.Shapes("OfferLetterTemplate")
''The OLE Object contained
Set objOL = sh.OLEFormat.Object
'Instead of activating in-place, open in Word
objOL.Verb xlOpen
'Set objWord = objOL.Object 'The Word document
Set objNewDoc = objOL.Object
Set objWord = objNewDoc.Application
Dim objUndo As Object 'Word.UndoRecord
'Be able to undo all editing performed by the macro in one step
Set objUndo = objWord.UndoRecord
objUndo.StartCustomRecord "Edit In Word"
With objNewDoc
'Cover page
.Bookmarks("CoverPageTitle").Range.Text = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
objNewDoc.SaveAs2 Environ$("Temp") & "\" & _
"MyFile" & ".docx"
objUndo.EndCustomRecord
objNewDoc.Undo
.Application.Quit False
End With
Set objWord = Nothing
Set objUndo = Nothing
Set sh = Nothing
Set wSystem = Nothing
Set objNewDoc = Nothing
'Application.ScreenUpdating = True
End Sub
You can check how this behaves on my computer here: https://streamable.com/2xd8k
You can see (by time of creation of file) that it is getting overwritten every time even when there is an error.
Apologies in advance for the length of this post, but I wanted to describe my issues in detail in the hopes one of you VBA masters can assist
Goal
Loop through all PDFs in a folder
For each PDF:select all/copy/paste into Excel
Call a separate macro to convert the pasted data into something
legible.
Background
The below sub [CopyPDFtoExcel()] worked yesterday but is now failing on the ActiveSheet.Paste line with the
"Runtime error '1004' Paste method of Worksheet class failed".
If I step though (via F8), it appears to NOT be actually opening the PDF, and therefor is unable to select all/copy/paste, producing the Runtime error. However, I do not get an error dialog, which I would think I would get (from the Debug.Assert False) if it can't find the file.
My fName's are defined as variable via a named range called path2008. These file paths were derived by running PullFilePathsforPDFs(), which spits out the full file path for each PDF in my folder. Then, I have selected those file paths and given it a name, in this case path2008, which is for 13 different PDFs. NOTE: There are actually 250+ PDFs in this folder but I selected a subset for testing, hence the 13 associated with path2008.
What I have done so far
Tested the file path for each PDF in the path2008 range by using the
(cumbersome non-looping) ActiveWorkbook.FollowHyperlink method,
which successfully opens all the PDFs. So, I'm pretty confident the
file paths are correct.
'ActiveWorkbook.FollowHyperlink "file path here"
Stripped out the select all/copy/paste VBA code, leaving just the
loop [See the sub TroubleshootingOpeningPDFLoop()]. When I step
through the FIRST time the yellow line goes from the Set oPDDoc =
oAVDoc.GetPDDoc line to the End If....presumabley meaning it found a
file during the first loop (though I do not see the PDF open). On
the SECOND (and all subsequent loops) it goes to Else then
Debug.Assert False (but no error dialog appears).
Restarted Excel and Acrobat, same issue
Restarted computer, same issue
Recreated a new workbook, same issue
Main code
Sub CopyPDFtoExcel()
Dim fName As Variant
Dim wbPayroll As Excel.Workbook
Dim wsConvert As Excel.Worksheet
Dim oPDFApp As AcroApp
Dim oAVDoc As AcroAVDoc
Dim oPDDoc As AcroPDDoc
Set wbPayroll = Workbooks("Payroll.xlsm")
Set wsConvert= wbPayroll.Sheets("Convert")
Set oPDFApp = CreateObject("AcroExch.App")
Set oAVDoc = CreateObject("AcroExch.AVDoc")
Set oPDDoc = CreateObject("AcroExch.PDDoc")
'Open the PDF file. The AcroAVDoc.Open function returns a true/false
For Each fName In Range("path2008")
If oAVDoc.Open(fName.Text, "") = True Then
Set oPDDoc = oAVDoc.GetPDDoc
Else
Debug.Assert False
End If
'Copy all using Acrobat menu
oPDFApp.MenuItemExecute ("SelectAll")
oPDFApp.MenuItemExecute ("Copy")
'Paste into Convert sheet
wbPayroll.Activate
wsConvert.Cells(1, 1).Select
ActiveSheet.Paste 'It worked yesterday, but now error on this line with below error
'Runtime error '1004' Paste method of Worksheet class failed
oAVDoc.Close (1) '(1)=Do not save changes
'oPDDoc.Close
Call ConversionMacro
Next
'Clean up
Set wbTransfer = Nothing
Set wsNew = Nothing
Set oPDFApp = Nothing
Set oAVDoc = Nothing
Set oPDDoc = Nothing
End Sub
My effort to isolate the PDF open failure problem
Sub TroubleshootingOpeningPDFLoop()
Dim fName As Variant
Dim wbPayroll As Excel.Workbook
Dim wsConvert As Excel.Worksheet
Dim oPDFApp As AcroApp
Dim oAVDoc As AcroAVDoc
Dim oPDDoc As AcroPDDoc
'Define your spreadsheet
Set wbPayroll = Workbooks("Payroll.xlsm")
Set wsConvert= wbPayroll.Sheets("Convert")
'Instantiate Acrobat Objects
Set oPDFApp = CreateObject("AcroExch.App")
Set oAVDoc = CreateObject("AcroExch.AVDoc")
Set oPDDoc = CreateObject("AcroExch.PDDoc")
'Open the PDF file. The AcroAVDoc.Open function returns a true/false
For Each fName In Range("path2008")
If oAVDoc.Open(fName.Text, "") = True Then
Set oPDDoc = oAVDoc.GetPDDoc
Else
Debug.Assert False
End If
Next
End Sub
Sub used to pull the file paths
Sub PullFilePathsforPDFs()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:\Stuff\MoreStuff") 'all PDFs I need are stored here
i = 1
For Each objFile In objFolder.Files
Cells(i + 1, 1) = objFile.Name
Cells(i + 1, 2) = objFile.Path
i = i + 1
Next objFile
End Sub
I am having cut/copy - paste troubles lately (runtime error 1004)
Using the latest Excel but also working on "ancient" applications.
What did the trick for me was working with the original "given" name
(Sheet1,Sheet2 etc. As soon as I added/renamed the same sheets, the runtime errors came back.
If you want to make sure to generate an error when the opening operation does not succeed, I would add the following at the end of TroubleshootingOpeningPDFLoop:
If oPDDoc is nothing then
Debug.Assert False
End If
If this doesn't return an error, that means that the file is open in the application, but that it is not visible. It could be caused by the fact that you are using a PDDoc instead of an AVDoc. So, switching the 2 might allow you to see it when debugging.
As of your main problem, it might be due to the fact that Acrobat does not process the commands fast enough and you need to include some waiting time in your code to let Acrobat enough time to process the command. For example, you could have:
'Copy all using Acrobat menu
oPDFApp.MenuItemExecute ("SelectAll")
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1)
oPDFApp.MenuItemExecute ("Copy")
Which will make VBA wait one second before running the next command.
I have a Word template file that retrieves data from an Excel file to populate a form.
The code looks something like this:
Dim myXL As Object
Set myXL = Getobject("myfile.xls")
myXL.Application.Visible = True
myXL.Parent.Windows(1).Visible = True
This code works fine in Office 2010 and 2007, but when I try it in 2013, it gives run time error 9 which is an array subscript error. When I check the Windows array it has zero elements, so error is correct.
How do I achieve the same result in 2013?
The next bit of code attempts to access the Worksheets("mysheet") and if I skip the Visible = True line accessing the worksheet gives runtime error 1004.
Any help with fixing this would be greatly appreciated.
To make the code work on Office 2013 I added the line myXL.Activate before trying to make the Window visible. So the code becomes:
Dim myXL As Object
Set myXL = Getobject("myfile.xls")
myXL.Application.Visible = True
myXL.Activate
myXL.Parent.Windows(1).Visible = True
This fixed the run-time error, and the code went back to working well.
To retrieve data from an Excel
An Example would be...
Option Explicit
Sub ExcelData()
Dim xlApp As Object ' Application
Dim xlBook As Object ' Workbook
Dim xlSht As Object ' Worksheet
Dim FilePath As String
FilePath = "C:\Temp\Book1.xlsx"
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(FilePath)
Set xlSht = xlBook.Sheets("Sheet1")
With ActiveDocument
.Content = xlSht.Range("A1").Value
End With
xlApp.Visible = True
Set xlApp = Nothing
Set xlBook = Nothing
End Sub
I'm writing a macro in Access that (hopefully) will:
create an Excel worksheet
set up and format it based on information in the Access database
after user input, will feed entered data into an existing Excel master file
Opening the blank sheet etc. is working absolutely fine, but I'm stuck trying to set the existing master file up as a variable:
Sub XLData_EnterSurvey()
Dim appXL As Excel.Application
Dim wbXLnew, wbXLcore As Excel.Workbook
Dim wsXL As Excel.Worksheet
Dim wbXLname As String
Set appXL = CreateObject("Excel.Application")
appXL.Visible = True
wbXLname = "G:\[*full reference to file*].xlsm"
IsWBOpen = fnIsWBOpen(wbXLname)
'separate function (Boolean), using 'attempt to open file and lock it' method
'from Microsoft site.
If IsWBOpen = False Then
Set wbXLcore = appXL.Workbooks.Open(wbXLname, True, False)
'open file and set as variable.
ElseIf IsWBOpen = True Then
wbXLcore = appXL.Workbooks("ResultsOverall.xlsm") 'ERROR HERE.
'file is already open, so just set as variable.
End If
Debug.Print wbXLcore.Name
Debug.Print IsWBOpen
Set appXL = Nothing
End Sub
When the file is closed, this works perfectly. However, when it's open I get:
Run-Time error '9':
Subscript out of range
I'm only just starting to teach myself VBA (very trial and error!) and nothing else I've seen in answers here / Google quite seems to fit the problem, so I'm a bit lost...
Considering that it works fine when the file is closed, I suspect I've just made some silly error in referring to the file - perhaps something to do with the 'createobject' bit and different excel instances??
Any suggestions would be much appreciated! Thanks
Thank you #StevenWalker
Here's the working code:
Sub XLData_EnterSurvey()
Dim appXL As Excel.Application
Dim wbXLnew As Excel.Workbook, wbXLcore As Excel.Workbook
Dim wsXL As Excel.Worksheet
On Error GoTo Handler
Set appXL = GetObject(, "Excel.Application")
appXL.Visible = True
Dim wbXLname As String
wbXLname = "G:\ [...] .xlsm"
IsWBOpen = fnIsWBOpen(wbXLname)
If IsWBOpen = False Then
Set wbXLcore = appXL.Workbooks.Open(wbXLname, True, False)
ElseIf IsWBOpen = True Then
Set wbXLcore = appXL.Workbooks("ResultsOverall.xlsm")
End If
Set appXL = Nothing
'-------------------Error handling------------------
Exit Sub
' For if excel is not yet open.
Handler:
Set appXL = CreateObject("Excel.Application")
Err.Clear
Resume Next
End Sub
Sorry I'm on my phone so I can't go in to too much detail or do much with the code but at a glance I think you might need to add an error handler so that if the file is already open, a different line of code is executed.
Add 'On error go to handler' (before creating the excel object) and at the bottom
Of your code add 'handler:'. In the error handler, use get object rather than create object.
You will have to ensure you use exit sub before the error handler or it will run the handler every time you run the code.
You can see an example of what I mean here: How to insert chart or graph into body of Outlook mail
Although please note in this example it's the other way round (if error 'getting' outlook, then create it).
Example in link:
Set myOutlook = GetObject(, "Outlook.Application")
Set myMessage = myOutlook.CreateItem(olMailItem)
rest of code here
Exit Sub
'If Outlook is not open, open it
Handler:
Set myOutlook = CreateObject("Outlook.Application")
Err.Clear
Resume Next
End sub
If you move the appXL.Workbooks statement to the debugging window, you will find that the names of the items in that collection are without extension.
So in your case, I'm guessing the line should read:
wbXLcore = appXL.Workbooks("ResultsOverall")
Created a simple access DB with only 1 form and 1 one button to run code that opens an existing empty excel (with 1 worksheet) and writes "X" in its 1st cell. It does the job but the workbook is hidden and I have to manually unhide it. That is, after the VBA code is executed I open the excel file and it is all grayed out. I have to click the "view" tab and then select the "Unhide" option and all is fine and I can see that the cell was updated as needed. If I take out the VBA line that writes "X" in the excel file, it doesn't hide the workbook. How do I solve the problem of the workbook being hidden?
Windows 7 and Office2013.
Thank you!!!
Here is the code:
Private Sub Command0_Click()
Dim my_xl_app As Object
Dim my_xl_worksheet As Object
Dim my_xl_workbook As Object
Set my_xl_app = CreateObject("Excel.Application")
my_xl_app.UserControl = True
my_xl_app.Visible = False ' yes. I know it's the default
Set my_xl_workbook = GetObject("D:\Dropbox\MASAV\HIYUVIM\AAA.xlsx")
Set my_xl_worksheet = my_xl_workbook.Worksheets(1)
my_xl_worksheet.Cells(1, "A") = "V"
my_xl_workbook.Close SaveChanges:=True
Set my_xl_app = Nothing
Set my_xl_workbook = Nothing
Set my_xl_worksheet = Nothing
End Sub
S o l v e d !!!
Here is the code that works without hiding my entire workbook :
Private Sub Command0_Click()
Dim my_xl_app As Object
Dim my_xl_worksheet As Object
Dim my_xl_workbook As Object
Set my_xl_app = CreateObject("Excel.Application")
Set my_xl_workbook = my_xl_app.Workbooks.Open("D:\Dropbox\MASAV\HIYUVIM\AAA.xlsx")
Set my_xl_worksheet = my_xl_workbook.Worksheets(1)
my_xl_workbook.Sheets(1).Range("A1").Value = "V"
my_xl_workbook.Close SaveChanges:=True
Set my_xl_app = Nothing
End Sub
Got the answer right here in this this forum, in another thread which escaped my eyes...
Thanks a lot to all in this wonderful forum!!!!
Use this:
Workbooks(1).Windows(1).Visible = True