I already posted a closely related question last week VBScript to add code to Excel workbook which got solved by a fellow programmer. But I ran into the next problem with that task:
With the following code, I try to loop through a folder of Excel files then open them one by one and change the macro in DieseArbeitsmappe. This works fine for the first file but the second ends with this error message.
Error message
Set objFSO = CreateObject("Scripting.FileSystemObject")
sFolder = "P:\Administration\Reports\operativ\Tagesbericht\templates\START07\TestTabsiNeu\"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
For Each objFile In objFSO.GetFolder(sFolder).Files
Set objWorkbook = objExcel.Workbooks.Open(sFolder & objFile.Name)
Set component = objworkbook.VBProject.VBComponents("DieseArbeitsmappe")
strCode = _
"Sub WorkBook_Open() 'just for testing" & vbCr & _
" Application.Run (""'CommonMacro.xlsm'!Workbook_Open"")" & vbCr & _
"End Sub"
component.CodeModule.AddFromString strCode
objWorkbook.SaveAs "P:\Administration\Reports\operativ\Tagesbericht\templates\START07\TestTabsiNeu\" & objFile.Name
objExcel.Quit
Set objWorkbook = Nothing
Set component = Nothing
Next
Set objFSO = Nothing
Set objExcel = Nothing
Line 10 is Set component = objworkbook.VBProject.VBComponents("DieseArbeitsmappe")
Another problem I will face soon is that sometimes the VBComponent is called ThisWorkbook. So I will have to introduce if-else based on the Error code thrown by Line 10. Or is there a better solution for this?
Thanks in advance for your help.
This isn't a perfect answer, as I am more confused than I am certain of the exact problem... However hopefully this will help.
The command objExcel.Quit is going to close the Excel application.
I'm not quite sure how the code (in the next loop) then successfully executes
Set objWorkbook = objExcel.Workbooks.Open(sFolder & objFile.Name)
when the objExcel application has been quit. However, the .Visible and .DisplayAlerts will no longer be set True/False. The latter could cause your failure in line 10.
Therefore I suggest replacing
objExcel.Quit
with
objWorkbook.Close
Related
My VBScript opens all "xlsm" files in a folder, runs VBA code "Slim" and closes the workbook (one-by-one). It works fine, but I struggle with error handling. If the script tries to open a workbook currently open by someone else, I end up with error popup Someone else is working in /path + wb-name/ right now. Please try again later. and the loop pauses up until OK is clicked on the warning message. Looks like it will open the workbook no problem, but ends up with an error at the end since the VBA code saves a new file and tries to delete the old one. Hence, I'll end up with a new file and non-deleted old one on top of the error message.
While clearly not the ideal solution, quitting the whole loop in this scenario would also be better than waiting for the OK to be clicked, since VBScript is automated to launch.
I'd need to build an error handling for this scenario, so that already opened file would just be skipped and the loop would continue uninterrupted. Unfortunately, DisplayAlerts = False good ol' On Error Resume Next won't do it here.
If possible in a reasonable way, I'd like to solve this through VBScript and not adjust the VBA code.
Set fso = CreateObject("Scripting.FileSystemObject")
Set xl = CreateObject("Excel.Application")
On Error Resume Next
xl.DisplayAlerts = False
For Each f In fso.GetFolder("G:\Archive").Files
If LCase(fso.GetExtensionName(f.Name)) = "xlsm" Then
Set wb = xl.Workbooks.Open(f.Path)
xl.Run "Slim"
wb.Close
End If
Next
xl.Quit
Set fso = Nothing
Set xl = Nothing
Tried different scenarios, haven't cracked it so far. Latest option was this, but didn't help (is there a different way of checking if the workbook is currently read-only)?
For Each f In fso.GetFolder("G:\Archive").Files
If LCase(fso.GetExtensionName(f.Name)) = "xlsm" Then
Set wb = xl.Workbooks.Open(f.Path)
If NOT wb.ReadOnly Then
xl.Run "Slim"
wb.Close
Else
wb.Close
End If
End If
Next
If an excel file is open, opening it again is blocked. Renaming the file is also blocked, but a failed rename does not show a message box with resume next
Try this code. It tries to rename the file first. If the rename succeeds, it renames back then runs the macro. If rename fails, it skips the file.
Set fso = CreateObject("Scripting.FileSystemObject")
Set xl = CreateObject("Excel.Application")
On Error Resume Next
xl.DisplayAlerts = False
For Each f In fso.GetFolder("D:\MikeStuff\StackOverflow\ExcelCheckOpen").Files
If LCase(fso.GetExtensionName(f.Name)) = "xlsm" Then
xpath = f.Path ' file path lost after rename
fso.MoveFile xpath, xpath & ".txt" ' will fail if file locked by excel
if fso.FileExists(xpath & ".txt") Then ' rename worked, file not locked
fso.MoveFile xpath & ".txt", xpath ' rename back
Set wb = xl.Workbooks.Open(xpath)
xl.Run "Slim"
wb.Close
End If
End If
Next
xl.Quit
Set fso = Nothing
Set xl = Nothing
I am trying to write a code that copies the contents of multiple worksheets in a single workbook into a single word document. I want the content of each worksheet to be on its own page, but right now, my code is just copying and pasting over each other instead of going onto a new page and pasting. I've tried going to the end of the document but it isn't working... Any advice would be helpful.
Sub ToWord()
Dim ws As Worksheet
Dim Wkbk1 As Workbook
Set Wkbk1 = ActiveWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
Dim wdapp As Object
Dim wddoc As Object
Dim Header As Range
Dim strdocname As String
'file name & folder path
On Error Resume Next
'error number 429
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'create new instance of word application
Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
'define paths to file
strdocname = "C:\Doc.doc"
If Dir(strdocname) = "" Then
MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Doc.doc", vbExclamation, "The document does not exist "
Exit Sub
End If
wdapp.Activate
Set wddoc = wdapp.Documents(strdocname)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(strdocname)
'must activate to be able to paste
wddoc.Activate
wddoc.Range.Paste
Next ws
'Clean up
Set wddoc = Nothing
Set wdapp = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
you can just use:
wddoc.Range(i).Paste
incrementing i by 1 after each image. that pastes them one after another.
or more simply:
wddoc.Range(wddoc.Characters.Count-1).Paste
then could get more complicated and add a page break manually in between each if images are small to ensure a new page for each:
wddoc.Range(wddoc.Characters.Count-1).InsertBreak Type:=7
https://msdn.microsoft.com/en-us/library/office/ff821608.aspx
EDIT
First, I incorrectly assumed the "wddoc.range" property would get wherever the cursor is. This is not true. You need to use the code provided by Miss Palmer (and replicated below).
However, there is an additional issue I didn't notice at first. Your loop is set incorrectly. You are looping through and continually reopening the word doc. You need to move these lines:
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
so that they are immediately above the
wddoc.Range(wddoc.Characters.Count - 1).Paste
line. This will cause the loop to be executed properly and only open the word doc once.
Also (again, per Miss Palmer), you want to put this:
wddoc.Range(wddoc.Characters.Count - 1).Paste
wddoc.Range(wddoc.Characters.Count - 1).InsertBreak (wdPageBreak)after the line:
instead of the ".range.paste" that you originially had.
The other issue with your "Selection" line is that you did not specify the application you wanted to use. This was using Excel's selection by default as it was being run from Excel.
This code assumes that you have a word document that doesn't have enough pages. Otherwise you could likely use the code you want, but it's unclear why you would have a blank word document with many pages. You'd still need to specify the app you want to move to the next page in, so put "wdapp." before the selection line.
http://word.tips.net/T000120_Jumping_to_the_Start_or_End_of_a_Document.html
World!
I am trying to automate a report task at my job and I have the following situation:
I need to execute a macro on a workbook by using a script. I tried to write a vbscript to do the job, and this is the significant part of it:
Set objWbk = GetObject("***Path***\test.xlsm")
objWbk.Application.Run "test.xlsm!test"
WScript.Quit
The macro runs perfectly. My real problem is that I only want to do the report only if the workbook is open.
Is there a way (in vbs or vba) to determine if that workbook is open ? (by the way, it is located on another computer on my network)
Since you want to run the macro only when the workbook is already opened, something like this might work:
wbName = "test.xlsm"
wbFullName = "***Path***\" & wbName
Set xl = GetObject(, "Excel.Application")
For Each wb In xl.Workbooks
If LCase(wb.Path & "\" & wb.Name) = wbFullName Then
wb.Application.Run wbName & "!test"
End If
Next
This is not fully tested and may a need a bit of modification but see if it gets you what you need.
On Error Resume Next
Set objWbk = GetObject("***Path***\test.xlsm")
If Err.Number = 0 Then objWbk.Application.Run "test.xlsm!test"
wScript.Quit
I have made a code in vba which works with different Workbooks and Worksheets. This code must be execute in a scheduled task. But for an unknow reason I have a problem with it :
When I execute it manually, it works fine and excel closes itself. But with my scheduled task, Excel closes all Workbooks and Worksheets but it stays open.
Here you have my code :
Set xlApp = GetObject(, "excel.application")
Set wkbMe = xlApp.ActiveWorkbook
test = False
xlApp.DisplayAlerts = False
xlApp.AskToUpdateLinks = False
'Open files
xlApp.Workbooks.Open Filename:=MarketDataPath & WbRiskedge, ReadOnly:=True
xlApp.Workbooks.Open Filename:=MarketDataPath & WbMarketData, ReadOnly:=True
Set WorksheetIncoming = xlApp.Workbooks(WbMarketData).Worksheets(wsIncoming)
Set WorksheetMarketdata = xlApp.Workbooks(WbMarketData).Worksheets(WsMarketData)
xlApp.Workbooks.Open Filename:=GTPath & WbGoodTime, ReadOnly:=True
Cells.Copy
WorksheetIncoming.Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(WbGoodTime).Close
WorksheetMarketdata.Calculate
Worksheets(wsMarketDataForWebsite).Calculate
Worksheets(wsMarketDataForWebsite).Activate
If test = False Then
Application.Run "MarketEnv.xlsm!subCreateCSV"
End If
Workbooks(WbMarketData).Close , False
Workbooks(WbRiskedge).Close , False
xlApp.DisplayAlerts = True
xlApp.AskToUpdateLinks = True
ThisWorkbook.Save
ThisWorkbook.Saved = True
xlApp.Quit
End Sub
I have tried different solutions found on the web but nothing work. Even if I only make :
Set xlApp = GetObject(, "excel.application")
xlApp.Quit
End Sub
my excel stays open.
Anyone can help me plz ?
Okay, this seems long winded... but here goes.
The problem you are seeing is because there can be more than one instance of the Excel Application on a machine at a given time.
When you are manually running the file, you are likely using the default behavior, which is that when you open a workbook directly it opens in your already loaded Excel Application.
This means that when you use:
Set xlApp = GetObject(, "excel.application")
It is actually returning the current Excel.Application.
However, when you load it via the scheduled task, it generates a new Excel.Application in order to handle your task. When it calls the code I quoted it ends up referencing the Excel.Application you already had open (probably).
Since your scheduled workbook is running in a different instance of Excel.Application, when you run xlApp.Quit it only quits that other Excel and not the one actually running the code.
If you want to also close your automated Excel, you will need to add Application.Quit to the end of your sub. Yes, I do mean use both xlApp.Quit AND Application.Quit.
Now technically, you could have more than one Excel Applications open when you load the new one. If you want to close all instances of Excel, the simplest way I know would be to kill all of them via a vbscript call to a program like this which terminates all processes named excel.exe. Note I did not test this on Win 7:
Dim objWMIService, objProcess, colProcess
Dim strComputer, strProcessKill, strFilePath
strComputer = "."
strProcessKill = "'excel.exe'"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = " & strProcessKill)
For Each objProcess In colProcess
objProcess.Terminate
Next
WScript.Quit
Edit: I just wanted to add that you can replicate the behavior of the scheduled task manually by doing the following:
Have Excel already open.
Navigate through your start menu and open Excel.
From the new instance of Excel, open your workbook.
OR
Have Excel already open.
Run the following Excel.exe [path of workbook in quotes]
Edit 2:
Due to your request, I've written this short vbscript file that will close all open Excel Applications without upsetting auto-recover. If you also want to avoid any, "Do you want to save ..." alerts uncomment the commented section.
On Error Resume Next
Dim xlApp
Set xlApp = GetObject(, "Excel.Application")
Do While Err.Number <> 429
'For each wb in xlApp.Workbooks
' wb.saved = true
'next
xlApp.Quit
Set xlApp = Nothing
Set xlApp = GetObject(, "Excel.Application")
Loop
Wscript.quit
To run it, just include the following at the end of your Excel VBA.
Shell "wscript.exe [path of .vbs file]"
I can see you have opened more than one workbook instances with your excel application. You need to close all workbook instances to get the plain excel application and than quit it.
try this: (pseudo code)
dim xlApp as Excel.Application
dim wBook as Excel.Workbook
dim wSheet as Excel.Worksheet
Set xlApp = new Excel.Application
Set wBook = xlApp.Workbooks.Add(wb_Path)
Set wSheet = wBook.Sheets(1)
wSheet.Range("A1").Value = "Hello this is a test from vbcode"
wbook.close saveChanges:= true
xlApp.quit
Above code will open your workbook. write a custom message on your worksheet
saves the changes and closes. and the xlapp will also be terminated/destroyed.
I am trying to call my excel macro using vbs. Here is a snippet of my code.
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Folder\Test_PO.xls")
objExcel.Application.Visible = True
objExcel.Application.Run "C:\Folder\Test_PO.xls!Data_Analysis"
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
WScript.Echo "Finished."
WScript.Quit
Now the problem here is that i am able to open the file but the macro somehow gets disabled here and shows me 'macro may not be present or may be disabled'. I am sure i am calling correct macro name but as soon as the file is opened the Add-ins tab where i had configured the macro to run from gets dissapeared.This does not open if i open the file manually , i can see the tab and run the macro from the tab itself. Any suggestions how i could overcome this problem and get the macro to run ?
Try this
Dim objExcel, objWorkbook
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Folder\Test_PO.xls")
objExcel.Visible = True
objExcel.Run "Data_Analysis"
objWorkbook.Close
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
WScript.Echo "Finished."
WScript.Quit
EDIT
If the macro is in a module then the above will help. If the macro is in a sheet say, Sheet1 then replace the line
objExcel.Run "Data_Analysis"
with
objExcel.Run "sheet1.Data_Analysis"
FOLLOWUP
Try this code.
Dim objExcel, objWorkbook, ad, FilePath
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
For Each ad In objExcel.AddIns
If ad.Name = "Converteam.xla" Then
FilePath = ad.Path & "\Converteam.xla"
Exit For
End If
Next
objExcel.Workbooks.Open (FilePath)
Set objWorkbook = objExcel.Workbooks.Open("C:\Folder\Test_PO.xls")
objExcel.Run "Data_Analysis_Converteam"
objWorkbook.Close
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
WScript.Echo "Finished."
WScript.Quit
EXPLANATION:
When you use CreateObject, the Add-Ins are not installed by default. Please see this link.
Topic: Add-ins do not load when using the CreateObject command in Excel
Link: http://support.microsoft.com/kb/213489/
You have to load the Add-In and then call the relevant macro. Also the name of your macro is not Data_Analysis but Data_Analysis_Converteam
HTH
To add to Siddhart's answer - you can load the addins you require in a VBScript like this:
objExcel.RegisterXLL("analys32.xll") 'For XLL addins
objExcel.Workbooks.Open(objExcel.LibraryPath & "\analysis\atpvbaen.xla") 'For standard XLA addins
objExcel.Workbooks.Open("C:\Program Files\MyAddins\MyAddin.xla") 'for custom XLA addins