?
Solved

Disabling excel alerts using VB Script

Posted on 2014-04-02
19
Medium Priority
?
2,169 Views
Last Modified: 2014-04-23
Hi,

I have a script which opens excel sheets in a folder and copies and pastes data from them. However these excel sheets have some issues so when i open them there is an alerts which says :

Excel found unreadable contents in the workbook. Do you want to recover contents of this workbook? If you trust the source of this workbook, click Yes.

On clicking Yes, I get the following prompt:

Excel was able to open the file by repairing or removing the unreadable content. Removed feature: Data validation from /xl/worksheets/sheet1.xml part

I have attached a screenshot of the prompt. Is there a way i can override this and then copy data without any errors?

Thanks,
Aditya
Error-Prompt.png
0
Comment
Question by:adirisin
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 6
  • 3
19 Comments
 
LVL 70

Expert Comment

by:Qlemo
ID: 39972255
Just set .DisplayAlerts to false for the Excel Application object before opening the file. Or make sure the XLSX is created correctly ;-).
0
 

Author Comment

by:adirisin
ID: 39983905
Hi,

I did the .Displayalerts option to false, however this doesn't seem to work. Can i add a line of code which sends an email in case an excel file with unreadable content is found?

Here's what i have written:
Const DestinationFolder = "C:\Users\aditya.kumar.vaish\Downloads\Trial_Runs\Matcher Input\"
Dim dicErrors1 : Set dicErrors1 = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")

For Each f In fso.GetFolder(DestinationFolder).Files
  
If LCase(fso.GetExtensionName(f)) = "xlsx" Then
On Error Resume Next
Set wb = app.Workbooks.Open(f.Path)
If Err.Number <> 0 Then
dicErrors1.Add dicErrors1.count, fso.GetBaseName(wb.Name) & ".xlsx" 
Else 
newname = fso.BuildPath(wb.Path, fso.GetBaseName(wb.Name) & ".xls")
wb.SaveAs newname, -4143
    wb.Close True
f.Delete True
  End if
End If
Next

for y = 0 to dicErrors1.count - 1
  mailMessage1 = mailMessage1 & vbNewLine & dicErrors1.Item(y)
Next

If mailMessage1 <> "" Then
Mytim = Now
ToAddress = "aditya.kumar.vaish@abc.com"
MessageSubject = "Unread Information for list ran on " &Mytim
MessageBody = "Input files were not loaded due to unreadable contents." & vbNewLine & " Error number is " & Err.Number & "Error is " & Err.Description
Set ol = WScript.CreateObject("Outlook.Application")
Set ns = ol.getNamespace("MAPI")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = MessageBody1 & vbNewLine & vbNewLine & "Thanks," & vbNewLine & "Automatcher" & vbCrLf & MyTime1
newMail.RecipIents.Add(ToAddress)
newMail.Send
End If

Open in new window



Thanks,
Aditya
0
 
LVL 70

Expert Comment

by:Qlemo
ID: 39983921
Since that is a "fatal" error, I don't think you can skip that, or check for the error to occur and take action.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:adirisin
ID: 39983969
Hi,

Ok, thanks for the info.

Thanks,
Aditya
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 40007247
Hi, in your Open call, specify the 15th parameter for CorruptLoad.
http://msdn.microsoft.com/en-us/library/microsoft.office.interop.excel.workbooks.open.aspx

This should allow you to specify xlRepairFile. Add Const xlRepairFile = 1 to your code.  Checking the error code as you already are hopefully gives you what you need.

Rob.
0
 

Author Comment

by:adirisin
ID: 40012065
Hi Rob,

Thanks for the suggestion. Here's what i wrote:

Const xlRepairFile = 1
Const DestinationFolder = "C:\Users\aditya.kumar.vaish\Downloads\Trial_Runs\Matcher Input\"
Set app = CreateObject("Excel.Application")
app.Visible = true
app.DisplayAlerts = true
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder(DestinationFolder).Files  
If LCase(fso.GetExtensionName(f)) = "xlsx" Then
Set wb = app.Workbooks.Open(f.Path, CorruptLoad = xlRepairFile)
newname = fso.BuildPath(wb.Path, fso.GetBaseName(wb.Name) & ".xls")
wb.SaveAs newname, -4143
    wb.Close True
f.Delete True
  End if
Next

Open in new window


However, it doesn't seem to work and I get the error: "Unable to get the Open Property of the Workbooks."

Could you advise if I am wrong somewhere?

Thanks,
Aditya
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 40012357
Since the automation methods don't support the argument name when specifying parameters, you must present them in the exact order for the function.  Try
Set wb = app.workbooks.open(f.path,,,,,,,,,,,,,,xlRepairFile)

Rob.
0
 

Author Comment

by:adirisin
ID: 40012381
Hi Rob,

I tried this, however, i am still getting the same error: "Unable to get the Open Property of the Workbooks."

Aditya
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 40013323
What operating system and Office version are you running on? I will test it out.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 40013694
Hi, this has worked for me....

Const xlRepairFile = 1
Const DestinationFolder = "C:\Users\aditya.kumar.vaish\Downloads\Trial_Runs\Matcher Input\"
Set app = CreateObject("Excel.Application")
app.Visible = true
app.DisplayAlerts = true
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder(DestinationFolder).Files  
	If LCase(fso.GetExtensionName(f)) = "xlsx" Then
		Set wb = app.Workbooks.Open(f.Path, , , , , , , , , , , , , , xlRepairFile)
		newname = fso.BuildPath(wb.Path, fso.GetBaseName(wb.Name) & ".xls")
		'WScript.Echo "Saving as " & newname
		wb.SaveAs newname, -4143
		wb.Close True
		f.Delete True
	End if
Next
app.Quit

Open in new window


Rob.
0
 

Author Comment

by:adirisin
ID: 40014140
Hi Rob,

I tested it but it didn't work. I have shared the link to workbook that i have. Could you please see this and check if it works?

<LINK_REMOVED - RobSampson>

P.S. This data is confidential, please use it for testing only and destroy this copy later.

Regards,
Aditya
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 40014594
OK, so I finally found out that it worked on my Win7 x86 machine, but not my Win7 x64 machine.  It is related to the DCOM settings being incorrect, or missing.  I was reading here:
http://blogs.technet.com/b/the_microsoft_excel_support_team_blog/archive/2012/11/12/microsoft-excel-does-not-appear-in-dcom-configuration-snap-in.aspx

and ran
C:\WINDOWS\SysWOW64>mmc comexp.msc /32

from an elevated command prompt, and then I also ran
excel.exe -REGSERVER

from the directory where Excel.exe is.

This didn't immediately solve the problem for me yet, but I did at least see the DCOM entry when I ran
C:\Windows\SysWOW64\dcomcnfg.exe
and looked under
Computers --> My Computer --> DCOM Config --> Microsoft Excel Application
although I noticed the Location is not present and the "Run application on this computer" box is greyed out.  This suggests it is still not registered properly, so I will be doing a repair soon, but I don't have time right now.

If that still doesn't work for you, perform a Repair installation of Microsoft Office, and try the script again.

Regards,

Rob.
0
 
LVL 70

Expert Comment

by:Qlemo
ID: 40014612
Rob, just a side note - I tried on Vista x86 with a good XLSX and PowerShell, and the Open error as stated above appeared as soon as I provided the Format parameter (with "Nothing" resp. $null). I often use PowerShell to access Excel, so this is new to me.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 40016369
I just tested this again against a brand new, empty XLSX file, and it worked fine.  Aditya, can you test whether this works for you with a normal XLSX file?  I will do further testing with your corrupt file.

Rob.
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 total points
ID: 40016390
OK, strangely enough, it seems to work with I use the xlExtractData constant instead of the xlRepairFile constant.  See how this goes for you.

Regards,

Rob.

Const xlRepairFile = 1
Const xlExtractData = 2
Const DestinationFolder = "C:\Users\aditya.kumar.vaish\Downloads\Trial_Runs\Matcher Input\"
Set app = CreateObject("Excel.Application")
app.Visible = True
app.DisplayAlerts = False
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder(DestinationFolder).Files  
	If LCase(fso.GetExtensionName(f)) = "xlsx" Then
		'WScript.Echo "Opening " & f.Path
		Set wb = app.Workbooks.Open(f.Path, , , , , , , , , , , , , , xlExtractData)
		newname = fso.BuildPath(wb.Path, fso.GetBaseName(wb.Name) & ".xls")
		'WScript.Echo "Saving as " & newname
		wb.SaveAs newname, -4143
		wb.Close True
		f.Delete True
	End if
Next
app.DisplayAlerts = True
app.Quit

Open in new window

0
 

Author Closing Comment

by:adirisin
ID: 40016841
Hi Rob,

Thanks so much!! It's working now. I am glad that you were able to crack it. Awesome job!

Hi Qlemo,

Thanks for taking a shot at my query.

Regards,
Aditya
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 40016927
Ok great. Thanks for the grade.

Rob.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes a serious pitfall that can happen when deleting shapes using VBA.
Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question