Excel become unresponsive after running macro using vbs - vba

From VBS, I am running a macro "Inc" in an already opened excel workbook. The macro is getting executed (this is confirmed after seeing the updated cell value after reopening the workbook), but the excel becoming soon after I run the code. Can you please let me know what I need to change in my code.
Macro code :
Sub Inc()
Dim bs As Worksheet
Set bs = Workbooks("Main.xlsm").Sheets("TimeStampWork")
bs.Range("K11").Value = bs.Range("K11").Value + 1
bs.Range("L11").Value = Now
bs.Range("L11").NumberFormat = "dd-mm-yyyy, hh:mm:ss"
End Sub
VBS code :
Option Explicit
Dim xlApp, xlBook
Set xlBook = GetObject("E:\Main.xlsm")
Set xlApp = xlBook.Application
xlApp.Visible = True
xlApp.Run "Inc"
xlBook.Save
Set xlBook = Nothing
Set xlApp = Nothing
Update:
Instead of the macro "Inc" I tried to run a macro with just a simple message box, and it works without any issues. I can't see any problems with excel.

This issue has been resolved now. Changed my macro with screenupdate option which resolved the issue
Sub Inc()
Application.ScreenUpdating = False
Dim bs As Worksheet
Set bs = Workbooks("Main.xlsm").Sheets("TimeStampWork")
bs.Range("K11").Value = bs.Range("K11").Value + 1
bs.Range("L11").Value = Now
bs.Range("L11").NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Application.ScreenUpdating = True
End Sub

Related

Can't change the PaperSize & Orientation properties of the Excel's PageSetup class from VB.net

I'm trying to change paper size and sheet orientation of Excel worksheet,
Code runs without any errors, but nothing changes in Excel
Here a code:
Private Sub doCompare()
Dim xlApp As Excel.Application = Nothing
Dim DEs As Excel.Worksheet = Nothing
Dim Rws As Excel.Worksheet = Nothing
Dim ewb As Excel.Workbook = Nothing
XLapp = New Excel.Application
ewb = XLapp.Workbooks.Open("xxxxxxx0.xls")
DEs = ewb.Worksheets("Data Entry")
Rws = ewb.Worksheets("Comparing Results")
'Do something with these worksheets
'Now trying to change default settings. Code copied from Excel macro
xlApp.PrintCommunication = False
Rws.PageSetup.PrintArea = ""
DEs.PageSetup.PrintArea = ""
With Rws.PageSetup
.Orientation = Excel.XlPageOrientation.xlLandscape
.PaperSize = Excel.XlPaperSize.xlPaperA4
.FitToPagesWide = 1 'Fit All Columns to page
End With
xlApp.PrintCommunication = True
End Sub
Printer driver is installed
#Maxim Tried your code and it is working. Keep in mind that based on your code, you're changing the page setup ONLY for worksheet "Comparing Results". "Data Entry" remains unchanged.
-Feel free to upvote if answer is correct.

Deleting empty worksheets

I'm trying to write a code to delete empty worksheets in a workbook. So far I have been able to delete worksheets starting at the highest to the lowest using the code:
Dim i As Integer
Dim objExcel As Object = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Dim objWorkbook As Excel.Workbook = objExcel.Workbooks.Open(TextBox1.Text)
i = objWorkbook.Worksheets.Count
Do Until i = 2
objWorkbook.Worksheets(1).Delete()
i = i - 1
Loop
I had a look on the internet, but didn't find something that can be useful. Can anyone help me by guiding me to the right direction where I can obtain information on how to detect for empty worksheets in a single workbook using VB.net only.
Thank You
This should do the trick in vb.net
Private Sub DeleteBlankWorksheets(xlWorkBook As Excel.Workbook)
For i As Integer = xlWorkBook.Worksheets.Count To 1 Step -1
Dim ws As Excel.Worksheet = CType(xlWorkBook.Worksheets(i), Excel.Worksheet)
If Convert.ToInt64(ws.UsedRange.CountLarge) <= 1 Then
ws.Delete()
End If
Next
End Sub
Replace your entire loop with a call to this function, passing your objWorkBook object as the parameter.
Dim objExcel As Object = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Dim objWorkbook As Excel.Workbook = objExcel.Workbooks.Open(TextBox1.Text)
DeleteBlankWorksheets(objWorkbook)
'Add this to save the file
objWorkbook.Save()
objWorkbook.Close() 'closes the files
'If you have trouble with the file object being still opened, meaning you can see the EXCEL.exe in the task manager then add the following code
For Each instance As Process In Process.GetProcesses
If InStr(instance.MainWindowTitle, Textbox1.Text) <> 0 Then p.Kill()
Next
NOTE: It is better to make sure to dispose of all of your excel objects (applications, workbooks, worksheets, etc) than to kill processes. This will ensure all data is preserved as intended without side effects. If you find you have extra excel.exe instances running, make sure to double check everything is disposed and released properly.
This will do the job
Sub DeleteBlankWs()
Dim ws As Worksheet
For Each ws In Worksheets
If WorksheetFunction.CountA(ws.Cells) = 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
End Sub
I created an excel with 5 sheets, sheet 2 and 4 are empty, then I edited a micro and run it (F5 key or the green play icon)...

How to switch to open Excel spreadsheet and work on it from Word with VBA

I'm just trying to work on an open Excel spreadsheet from Word using VBA. I did a search on this and found the following code on How to get reference to an open Excel spreadsheet from Word?. The problem is, it seems to open a separate instance of Excel rather than the one I already have open, and then closes it after the action. How can I get the procedure to switch to the open Excel spreadsheet, perform the desired actions, and leave the spreadsheet open?
Sub DoStuffWithExcelInWord()
Dim xl As Excel.Application
Dim wkbk As Excel.Workbook
Dim wk As Excel.Worksheet
Set xl = CreateObject("Excel.Application")
Set wkbk = xl.Workbooks.Open("C:\test.csv")
Set wk = wkbk.Sheets(1)
Debug.Print wk.Cells(1, 1).Value 'Here's where I would like to insert my code
xl.Quit
Set wk = Nothing
Set wkbk = Nothing
Set xl = Nothing
End Sub
Thanks for any assistance!
Thanks again to dcromley for his earlier response. In the meantime, here's what I came up after a couple more searches on the Internet. It takes care of the situation where the Excel document is already open. Hopefully that will help others with similar situations, although it's not exhaustive (for example, if several Excel documents are open).
Sub DoStuffWithExcelInWordRevised()
Dim xl As Excel.Application
Dim wkbk As Excel.Workbook
Dim wk As Excel.Worksheet
On Error Resume Next
Set xl = GetObject(, "Excel.Application")
On Error GoTo 0
If xl Is Nothing Then
Set xl = CreateObject("Excel.Application")
Set wkbk = xl.Workbooks.Open("C:\test.xlsx")
Set wk = wkbk.Sheets(1)
End If
xl.Visible = True
With xl
' Insert Excel code here
End With
Set wk = Nothing
Set wkbk = Nothing
Set xl = Nothing
End Sub
Try:
Add xl.Visible = True
Del xl.Quit
It appears that you are trying to do this with a Workbook that is already open. Since you want to use the open workbook / application then you need to:
Set xl = GetObject(,"Excel.Application")

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?

How to define an object inside a for loop for excel vba

I want to import data from multiple workbooks, all from the same sheet index (3).
I'm new to vba, and I figured out how to open multiple files up, and also to copy data from one sheet to another sheet in a different workbook for a single file, but I can't seem to figure out how to do that for multiple files.
I highlighted where the error is, it tells me "object doesn't support this property or method"
Could you please help?
Thanks
Sub dataimport()
' Set Vars
Dim ArbinBook As Workbook, DataBook As Workbook
Dim i As Integer, j As Integer
Dim Caption As String
Dim ArbinFile As Variant, DataFile As Variant
' make weak assumption that active workbook is the target
Set DataBook = Application.ActiveWorkbook
' get Arbin workbook
Caption = "Please select an input file"
' To set open destination:
' ChDrive ("E")
' ChDir ("E:\Chapters\chap14")
' With Application
'Set "arbinfile" as variant, the "true" at end makes it into an array
ArbinFile = Application.GetOpenFilename(, , Caption, , True)
'Exit when canceled
If Not IsArray(ArbinFile) Then
MsgBox "No file was selected."
Exit Sub
End If
Dim targetSheet As Worksheet
Set targetSheet = DataBook.Sheets(1)
'Open for every integer i selected in the array "arbinfile"
For i = LBound(ArbinFile) To UBound(ArbinFile)
Set ArbinBook = Workbooks.Open(ArbinFile(i))
targetSheet.Range("A2", "G150").Value = ArbinBook.Sheets(3).Range("A2", "G150").Value
**ERROR at the line above**
Workbooks(DataSheet).Activate 'Reactivate the data book
Worksheets(1).Activate 'Reactivate the data sheet
ActiveWorkbook.Sheets(1).Copy _
after:=ActiveWorkbook.Sheets(1)
Workbooks(ArbinFile(1)).Activate 'Reactivate the arbin book(i)
ArbinBook.Close
Next i
Beep
End Sub
My instinct tells me that ArbinBook.Sheets(3) is a Chart-sheet, not a WorkSheet (or, at least, it is something other than a WorkSheet). It might be hidden as well, but it will still be indexed as (3).
If so, change Sheets(3) to Worksheets(3).
Added: BTW If true, this also demonstrates why using index-numbers is unreliable. If at all possible, refer to a worksheet by its name. (I appreciate that this may not always be possible.)
Added (from comments) There is nothing named DataSheet in your code. Add Option Explicit to the top of your module to indicate all such errors.
Try changing the line Set ArbinBook = Workbooks.Open(ArbinFile(i))
to Set ArbinBook = Workbooks(arbinfile(i))
I could be wrong, but I think it's trying to set your workbook object to become the action of opening another workbook, instead of labeling it as the workboook.
Sub Multiple()
Application.DisplayAlerts = False
Application.EnableEvents = False
Dim exlApp As Excel.Application
Dim exlWb1 As Excel.Workbook
Dim exlWb2 As Excel.Workbook
Dim exlWb3 As Excel.Workbook
Dim exlWs1 As Excel.Worksheet
Dim exlWs2 As Excel.Worksheet
Dim exlWs3 As Excel.Worksheet
Set exlApp = CreateObject("Excel.Application")
Set exlWb1 = exlApp.Workbooks.Open("C:\yourpath1\file1.xls")
Set exlWb2 = exlApp.Workbooks.Open("C:\yourpath2\file2.xls")
Set exlWb3 = exlApp.Workbooks.Open("C:\yourpath3\file3.xls")
Set exlWs1 = exlWb.Sheets("Sheet1")
Set exlWs2 = exlWb.Sheets("Sheet1")
Set exlWs3 = exlWb.Sheets("Sheet1")
exlWb1.Activate
exlWb2.Activate
exlWb3.Activate
'code
exlWb.Close savechanges:=True
exlWb.Close savechanges:=True
exlWb.Close savechanges:=True
Set exlWs1 = Nothing
Set exlWs2 = Nothing
Set exlWs3 = Nothing
Set exlWb1 = Nothing
Set exlWb2 = Nothing
Set exlWb3 = Nothing
exlApp.Quit
Set exlApp = Nothing
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub