VBScript - How do I get these workbooks to talk? - vba

I posted earlier about getting my VBScript to wait until a process had finished before continuing (further info: VBScript - How to make program wait until process has finished?.
I was given an adequate answer after some discussion. However, it seems that I am now going in a new direction with the code as the solution presented another problem that I am hoping you may be able to help me with.
Basically I have some code which I have provided below. It takes in 4 arguments, one of which is a PATH to a folder containing many files which I want to use along with the other three in my VBA macro.
If WScript.Arguments.Count = 4 Then
' process input argument
Set args = WScript.Arguments
arg1 = args.Item(0)
arg2 = args.Item(1)
arg3 = args.Item(2)
arg4 = args.Item(3)
' Create a WshShell instance
Dim WShell
Set WShell = CreateObject("WScript.Shell")
' Create an Excel instance
Dim x1
Set x1 = CreateObject("Excel.Application")
' Disable Excel UI elements
x1.DisplayAlerts = False
x1.AskToUpdateLinks = False
'x1.AlertBeforeOverwriting = False
x1.FeatureInstall = msoFeatureInstallNone
' Open the Workbooks specified on the command-line
Dim x1WB
Dim x2WB
Dim x3WB
Dim x4WB
Dim strWB1
Dim strWB2
Dim strWB3
Dim strWB4
Dim FSO
Dim FLD
Dim FIL
Dim strFolder
strWB1 = arg1
Set x1WB = x1.Workbooks.Open(strWB1)
' Show the workbook/Excel program interface. Comment out for silent running.
x1WB.Application.Visible = True
strWB2 = arg2
Set x2WB = x1.Workbooks.Open(strWB2)
' Show the workbook/Excel program interface. Comment out for silent running.
x2WB.Application.Visible = True
strWB3 = arg3
Set x3WB = x1.Workbooks.Open(strWB3)
' Show the workbook/Excel program interface. Comment out for silent running.
x3WB.Application.Visible = True
'To hold the string of the PATH to the multiple files
strFolder = arg4
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get a reference to the folder I want to search
set FLD = FSO.GetFolder(strFolder)
Dim strMyMacro
strMyMacro = "my_excel_sheet_with_vba_module.xlsm!Sheet1.my_vba_macro"
'loop through the folder and get the file names
For Each Fil In FLD.Files
WshShell.run """C:\Program Files\Microsoft Office\Office14\EXCEL.exe"" " & Fil, 1, true
x1.Run strMyMacro
'~~> Problem - How do I get the macro to run before opening the above file but run after it has opened (due to setting the bWaitOnReturn to true)
'~~> Problem - How do I get the file on current iteration to close after the macro has completed?
'~~> Problem - If this is not the issue, can you identify it?
Next
x1WB.close
x2WB.close
x3WB.close
'x4WB.close
' Clean up and shut down
Set x1WB = Nothing
Set x2WB = Nothing
Set x3WB = Nothing
Set x4WB = Nothing
Set FSO = Nothing
Set FLD = Nothing
x1.Quit
Set x1 = Nothing
Set WshShell = Nothing
WScript.Quit 0
Else
WScript.Quit 1
End If
The script works like this:
4 arguments are passed to the script. The 3rd argument is a .xlsm file which contains my VBA macro. The last argument is a PATH to a folder containing multiple files.
It then opens up the first three Excel files.
Then I run a loop to iterate through the files Fil in the folder that was specified as the 4th argument. AFAIK this has to be done via a WScript.shell using the .run method so that the rest of the script will hang until the Excel file it is processing finishes before closing it and opening up the next file in the folder.
After opening up file Fil, I then run the macro (albeit at this moment in time unsuccessfully).
I was tempted to simply open up all of the Excel files using the WScript.shell object however AFAIK I would not be able to run the macro this way.
Hopefully I have been able to define my aims of this piece of VBScript though if I haven't let me know and I shall clarify. Can you help?
Thanks,
QF.

Something along these lines might work for you (in Excel). A few things I'm not clear on though:
Where is your existing VBA macro - I'm guessing it's in one of the 3 files you're opening?
What types of files are in the folder you're looping through? I guessed Excel.
How is the vbscript being run? It looks like you're shelling out from your HTA, but why not include it directly in the HTA? That would save you from having to shell out and pass arguments...
Option Explicit
Dim wb1 As Workbook, wb2 As Workbook
Sub ProcessFolder(path1, path2, sFolder)
Dim wb As Workbook
Dim s
Set wb1 = Workbooks.Open(path1)
Set wb2 = Workbooks.Open(path2)
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
s = Dir(sFolder & "*.xls*", vbNormal)
Do While Len(s) > 0
Set wb = Workbooks.Open(sFolder & s)
ProcessFile wb
wb.Close False
s = Dir()
Loop
wb1.Close False
wb2.Close False
End Sub
Sub YourExistingMacro(wb As Workbook)
'do stuff with wb and presumably the other 3 open files...
End Sub

Related

Copy data from different excels in one and the same folder

I want to write a code in VBA, which copies data from different excel sheets, which are all in one folder, to another excel.
I tried to write an loop, which goes through the different excels in the folder, opens them, copy some content and then pastes it to the end of another excel workbook. For the last step I will have to work with "Dim last as long", but I am not there yet.
There is no defect note, but the macro doesn't do anything.
I am a newbie in VBA and would be very thankful for any advices!
Sub copypaste()
Dim strFileName As String
Dim strFolder As String: strFolder = "L:....xlsx"
Dim strFileSpec As String: strFileSpec = strFolder & "*.xlsx"
strFileName = Dir(strFileSpec)
Do While Len(strFileName) > 0
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open("strFileSpec")
Set y = Workbooks.Open("L:....xlsx")
'Now, transfer values from x to y:
y.Sheets("aaa").Range("C2:BI8").Value = x.Sheets("bbb").Range("A5:BG10")
x.Close
strFileName = Dir
Loop
End Sub
If your Do loop was executing, your code as given would raise some error(s). Since it's not, I figure your loop isn't executing, which you should have verififed before asking here. If you don't know how, please read Chip Pearson's excellent and brief tutorial about how to debug VBA:
http://www.cpearson.com/excel/DebuggingVBA.aspx
If your Do loop isn't executing, then there's a problem with your folder/file names and/or implementation of the DIR function.
strFolder for example looks very suspect, because "L:....xlsx" doesn't look like a valid folder path.
Dim strFolder As String: strFolder = "L:....xlsx"
Here's another problem. This line is instructing Excel to open a workbook (within the active directory) named "strFileSpec", this is a string literal, not your variable of similar identifier: strFileSpec. Because this line isn't raising an error, the problem is most likely as indicated above (loop not executing), but this is also a problem you need to fix:
Set x = Workbooks.Open("strFileSpec")
Should be:
Set x = Workbooks.Open(strFileName)
And it should be strFileName (the result of the Dir function) since that's the source of your copy/paste.
Further, you should probably be opening y outside of the loop, and ensuring that it's a valid filename, which it currently isn't:
Set y = Workbooks.Open("L:....xlsx")
So, putting that all together, this:
Sub copypaste()
Dim x As Workbook
Dim y As Workbook
Dim strFileName As String
Dim strFolder As String
Dim strFileSpec As String
Set y = Workbooks.Open("c:\users\your_name\desktop\file.xlsx") '<< This should be the file path of the file you're copying TO.
strFolder = "c:\users\your_name\desktop\" '<< make sure this is a valid path to a FOLDER
strFileSpec = strFolder & "*.xlsx"
strFileName = Dir(strFileSpec)
Do While Len(strFileName) > 0
Set x = Workbooks.Open("strFileSpec")
'Now, transfer values from x to y:
y.Sheets("aaa").Range("C2:BI8").Value = x.Sheets("bbb").Range("A5:BG10")
x.Close
strFileName = Dir
Loop
End Sub
NOTE the above just overwrites the same range destination, you'll need to make sure you're writing to a different destination with each iteration of the loop, something like:
Dim i as Long
Do While Len(strFileName) > 0
Set x = Workbooks.Open("strFileSpec")
'Now, transfer values from x to y:
With x.Sheets("bbb").Range("A5:BG10")
y.Sheets("aaa").Range("C2").Resize(.Rows.Count, .Columns.Count).Offset(i).Value = .Value
i = i + .Rows.Count + 1
End With
x.Close
strFileName = Dir
Loop

Execute .vbs from a batch for a specific workbook

I have a .bat file and I'm using it to execute a .vbs which I've pulled out of an excel workbook.
Currently, my .bat file looks like:
echo Starting program
start C:\Users\midi\Desktop\Refresh_Data_Connection.vbs
echo Finish program
However, the issue with my .vbs file is that it doesn't reference a specific workbook which I need it to. How could I set the .vbs to alter a specific workbook stored on my desktop? Any help/feedback or push in the right direction would be really helpful, thanks in advance!
My vbs is:
Sub RefreshConns()
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Sheets("Run Macro").Activate
Dim connName As String ' connection name
Dim connStr As String ' connection string
Dim sqltext ' SQL text
Dim TempconnName As String ' temporary connection name
Dim TempconnStr As String ' temporary connection string
Dim Tempsqltext ' temporary SQL text
Dim i As Integer
Dim SiteName As String
SiteName = ActiveSheet.Cells(1, 2)
'MsgBox (SiteName)
For i = 5 To 11
connName = ActiveSheet.Cells(i, 1).Value
connStr = ActiveSheet.Cells(i, 2).Value
sqltext = ActiveSheet.Cells(i, 4).Value
'MsgBox (connName)
TempconnStr = Replace(connStr, "SiteNameVBA", SiteName)
'Debug.Print (ActiveWorkbook.Connections(connName).ODBCConnection.Connection)
'MsgBox (TempconnStr)
'Tempsqltext = Replace(sqltext, "SiteNameVBA", SiteName)
'On Error Resume Next
ActiveWorkbook.Connections(connName).ODBCConnection.CommandText = sqltext
ActiveWorkbook.Connections(connName).ODBCConnection.Connection = "ODBC;" & TempconnStr
ActiveWorkbook.Connections(connName).Refresh
Next i
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Public Function ZeroToBlank(x As String) As String
If x = "0" Then
ZeroToBlank = ""
Else
ZeroToBlank = x
End If
End Function
One way is to declare a system environment variable using setx.
Running your batch with administration privilege try this:
setx PATHFILE "/path/file.xls" /M
Check if is declared:
set | find "PATHFILE"
And read it with the function Environ() to open you Workbook in your vbs:
Workbooks.Open Environ("PATHFILE")
EDIT
You do not need to use system environment variable (/m argument) as you can use only user environment. You need to just remember that the programs need to restart to read the user and system environment variable.
Set xlBook = GetObject("C:\Users\User\Documents\Super.xls")
For each wsheet in xlbook.worksheets
msgbox wsheet.name
next
Is how. Remember there are no excel constants in VBS, there is no dim x as something as vbs only does variants. so just dim x.
Other ways to a running copy of excel
Set GetExcelApp = GetObject("", "Excel.Application")
Msgbox GetExcelApp
To start a new excel and showing an excel constant replaced by it's value (43).
set xlapp = createobject("Excel.Application")
xlapp.Workbooks.Open "C:\Users\User\Documents\Super.xls"
'43 is 95/97 look up xlExcel9795 in object browser to see other options
xlapp.ActiveWorkbook.SaveAs "C:\Users\User\Documents\Super.xls", 43

Pass variable from PowerShell to VBA macro?

I have a PowerShell script that automates some report processing, and I have numerous separate macros to perform very similar autofilter functions, but on different criteria.
Is it possible to pass this criteria from PowerShell into the macro? I could then just have the 1 macro.
ColNum = Application.Match("*header", Range("A1:Z1"), 0)
If Not IsError(ColNum) Then
ActiveSheet.Range("A1").AutoFilter Field:=ColNum, Criteria1:="$criterafromPowerShell", Operator:=xlAnd
End If
I currently do a similar thing but the other way round, the output from these macros I insert to the workbook and extract back to PowerShell like so:
$counts = $workbook.worksheets.item(2)
$xRows = $counts.cells.item(1,1).Text
$yeRows = $counts.cells.item(1,2).Text
I concede I could possibly do this the other way round, and insert the text I want to use in a worksheet after the file is opened and before the macros are run, then pick it up inside the macro... but it seems messy.
Any suggestions?
Example:
$xlApp = New-Object -ComObject "Excel.Application"
$xlApp.Workbooks.Open("C:\Users\MacroMan\Documents\MyMacroWorkbook.xlsm")
$returnValue = $xlApp.Run("'MyMacroWorkbook.xlsm'!GenerateString", 6)
Echo $returnValue
FOOBAR
$returnValue = $xlApp.Run("'MyMacroWorkbook.xlsm'!GenerateString", 3)
Echo $returnValue
FOO
In the "MyMacroWorkbook" (VBA):
Public Function GenerateString(strLength As Integer) As String
GenerateString = Left("FOOBAR_SOMETHING", strLength)
End Function
I use the below code to pass two arguments from my VBscript to open a prticular workbook and launch required macro, you could pass the variable you want as a variable to the sub, i.e. Sub test(passedvariablehere) and make the sub to account for it:
'Create a WshShell to get the current directory
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
If (Wscript.Arguments.Count < 2) Then
Wscript.Quit
End If
'retrieve the arguments
Dim strWorkerWB
strWorkerWB = Wscript.Arguments(0)
Dim strMacroName
strMacroName = Wscript.Arguments(1)
' Create an Excel instance
Dim myExcelWorker
Set myExcelWorker = CreateObject("Excel.Application")
myExcelWorker.Application.Visible = True
' Open the Workbook specified on the command-line
Dim oWorkBook
Set oWorkBook = myExcelWorker.Workbooks.Open(strWorkerWB)
on error resume next
' Run the calculation macro
myExcelWorker.Run strMacroName
if err.number <> 0 Then
' Error occurred - just close it down.
oWorkBook.Close
Set oWorkBook = Nothing
myExcelWorker.Quit
Wscript.Quit
End If
err.clear
oWorkBook.Close
Set oWorkBook = Nothing
myExcelWorker.Quit
Set myExcelWorker = Nothing
Set WshShell = Nothing
on error goto 0
First argument is the fullpath/name to workbook, second argument is the sub name

How to parse a .doc file using a word VBA

I am stuck with this word VBA and in need of some assistance.I have 160 word documents in a folder and each .doc contains atleast one phrase like 'IO:' I want to copy all the file names that starts after 'IO:' and stop copying when the cursor finds Report Output:. Here is one sample input:
`Step Name: Step 3 – GP00BMDR
Step Description:: GENISYS main batch driver which processes external transactions and internal transactions, updates masters, generates transaction records to the accounting subsystem and produces print files.
File Specification:
Input: 1. GPFTRNW – PHGP.GPFTRNW.TRN.STD.KSDS
2. GPFSCIM – PHGP.GPFSCIM.SCI.KSDS
3. GPFSCSM – PHGP.GPFSCSM.SCS.KSDS
IO: 1. GPFPDGT – PHGP.GPFPDGT.PDG.TRN.KSDS
2. GPFRTXT – PHGP.GPFRTXT.RTX.KSDS
Report Output: Nil`
So I want to copy the .doc name and the file names after IO: and stops when the cursor reaches Report Output: . Here is my script:
Sub Ftp_Step_Details()
'this macro checks for FTP in respective steps and copy and writes in a cell along with the corresponding JCL
Dim wordApplication As Word.Application
Dim wordDocument As Word.Document
Dim flag As String
Dim Folder As String, J As String, FLD As Object
Dim Objfile As Object
Dim objfso As Object
Dim intRow As String
Dim contents As String
flag = True
Dim intResult As Integer
Dim strPath As String
'the dialog is displayed to the user
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog
If intResult <> 0 Then
'dispaly message box
strPath = Application.FileDialog( _
msoFileDialogFolderPicker).SelectedItems(1)
End If
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("D:\FILE-LIST\File-List.xlsx")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Cells(1, 1).Value = "Jcl Name"
objExcel.Cells(1, 2).Value = "File Names"
'Folder = "D:\TEST-IO" 'JCL source goes here
Set objfso = CreateObject("Scripting.FileSystemObject")
Set wordApplication = CreateObject("Word.Application")
intRow = 2
'Opening the file in READ mode
Set FLD = objfso.GetFolder(strPath)
For Each file In FLD.Files
Set Objfile = wordApplication.Documents.Open(file)
Do While Not Objfile.AtEndOfStream
contents = Objfile.ReadLine
If contents Like "*IO:" Then
flag = True
End If
If contents Like "*Report Output:*" Then
flag = False
End If
If flag = True Then
objExcel.Cells(intRow, 1).Value = file.Name
objExcel.Cells(intRow, 2).Value = contents3
intRow = intRow + 1
End If
Loop
Next
Objfile.Close
MsgBox "THANK YOU"
End Sub
Now whie testing the code i am getting TYPE MISMATCH in the step Set Objfile = wordApplication.Documents.Open(file) why is that?
Another doubt I have does Readline function works in word VBA as well?
Now whie testing the code i am getting TYPE MISMATCH in the step Set Objfile = wordApplication.Documents.Open(file) why is that?
Because File is type Scripting.File which is an Object, and the Documents.Open method expects a string.
You could try:
Documents.Open(file.Path)
Another doubt I have does Readline function works in word VBA as well?
No, I don't think so.

VBA - Automated PowerPoint won't open .pptx file that is being used by another User

I am creating a script that copies slides from various other .pptx files into a Master PowerPoint, but if one of the files is opened by another User at the same time the macro executes I receive an 80004005 error. My script is as follows:
Public Sub Update()
Dim PPTApp As Object
Dim PPT As Object
Dim MasterPPT As Presentation
Dim Total As Integer
Dim FSO As New Scripting.FileSystemObject
Dim Folder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim File As Scripting.File
Set MasterPPT = Presentations("Combined Staff Agenda Template.pptm")
Total = MasterPPT.Slides.Count
Set PPTApp = CreateObject("PowerPoint.Application")
' Sets the first ComboBox destination folder
Set Folder = FSO.GetFolder("O:\org\acle\Common\PE_SHARE\Technical Staff Meeting Agendas\Individual Slides\" & Order_UserForm.comboFirst.Value)
For Each SubFolder In Folder.SubFolders
For Each File In SubFolder.Files
' Copies and pastes all slides for each file
Set PPT = PPTApp.Presentations.Open(File.Path, ReadOnly:=msoTrue, WithWindow:=msoFalse)
PPT.Slides.Range.Copy
MasterPPT.Slides.Paste (Total)
PPT.Close
Total = MasterPPT.Slides.Count
Next File
Next SubFolder
The For Each loop is repeated twice for two more folders, and then the sub routine ends. The folder system is organized as follows: Parent Directory ("Technical Staff Meeting Agendas") > "Individual Slides" > Three (3) Department Folders > Individual User Folders with a .pptx file in each. Any workaround for accessing the File.Path if it is already opened?
Completely untested, but let's try something like this (assuming you're getting an error on Presentations.Open. I added an error-handling block around this method call, and based on the documentation (here) it looks like the .Open method's Untitled argument is equivalent to creating a copy of the file.
If that doesn't work, let me know. I can revise to explicitly create and open a copy of the file and open that, instead.
UPDATE Since the Untitled property didn't work, let's try explicitly creating a copy of the file. I did not include any "cleanup" code to remove the copied versions.
Public Sub Update()
Dim PPTApp As Object
Dim PPT As Object
Dim MasterPPT As Presentation
Dim Total As Integer
Dim FSO As New Scripting.FileSystemObject
Dim Folder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim File As Scripting.File
Set MasterPPT = Presentations("Combined Staff Agenda Template.pptm")
Total = MasterPPT.Slides.Count
Set PPTApp = CreateObject("PowerPoint.Application")
' Sets the first ComboBox destination folder
Set Folder = FSO.GetFolder("O:\org\acle\Common\PE_SHARE\Technical Staff Meeting Agendas\Individual Slides\" & Order_UserForm.comboFirst.Value)
For Each SubFolder In Folder.SubFolders
For Each File In SubFolder.Files
' Copies and pastes all slides for each file
On Error GoTo FileInUseError
Set PPT = PPTApp.Presentations.Open(File.Path, ReadOnly:=msoTrue, WithWindow:=msoFalse)
On Error GoTo 0
PPT.Slides.Range.Copy
MasterPPT.Slides.Paste (Total)
PPT.Close
Total = MasterPPT.Slides.Count
Next File
Next SubFolder
'## It's important to put this before your error-handling block:
Exit Sub
'## Error handling:
Err.Clear
'## First attempt, did not work as expected
'Set PPT = PPTApp.Presentations.Open(File.Path, ReadOnly:=msoTrue, Untitled:=msoTrue, WithWindow:=msoFalse)
'## Second attempt. You will need to add some logic to remove these files or do it manually.
Dim copyPath as String
copyPath = Replace(File.Path, File.Name, "Copy of " & File.Name)
FSO.CopyFile File.Path, copyPath, True
Set PPT = PPTApp.Presentations.Open(copyPath)
Resume Next
End Sub
Update 2
Other things you could try (not likely to work, but you should try them anyways):
I notice that this code is executing from within PowerPoint, so one thing that doesn't make sense is the: Set PPTApp = CreateObject("PowerPoint.Application"). You're already running an instance of PPT, and only one instance of PPT runs (unlike Excel which can have multiple instances). So get rid of that line entirely.
'Set PPTApp = CreateObject("PowerPoint.Application")
Then also you can get rid of the variable PPTApp. I notice you use a combination of early- and late-binding for your PowerPoint Object Variables. That doesn't really make sense and while I wouldn't expect that to cause any errors, you never know.
'Dim PPTApp as Object 'PowerPoint.Application '## This is unnecessary!!
Dim PPT as Presentation
Dim MasterPPT as Presentation
If all else fails, open the new file WithWindow=msoTrue and step through the code line by line using F8...
UPDATE 3
While I am not able to test a file that is locked/in-use by another user, I was able to test what happens if I have a file that is in use by myself. I use the following code and identify that the Files iteration will eventually encounter the lock/tmp version of the file, beginning with "~" tilde character. These are ordinarily hidden files, but FSO is picking them up in the iteration anyways.
Aside from that, I encounter similar errors if the file is not a valid PPT filetype (PPT, PPTX, PPTM, XML, etc.). I used the following code which prints a log of errors in the Immediate window (and informs you with MsgBox prompt) if there are errors.
Sub Test()
Dim MasterPPT As Presentation
Dim PPT As Presentation
Dim Total As Integer
Dim FSO As Object
Dim Folder As Object
Dim SubFolder As Object
Dim File As Object
Dim errMsg$
Dim copyPath$
Set MasterPPT = ActivePresentation '## Modify as needed.
Total = MasterPPT.Slides.Count
Set FSO = CreateObject("Scripting.FileSystemObject")
' Sets the first ComboBox destination folder // MODIFY AS NEEDED
Set Folder = FSO.GetFolder("C:\Users\david_zemens\Desktop\CHARTING STANDARDS")
For Each SubFolder In Folder.SubFolders
For Each File In SubFolder.Files
' Copies and pastes all slides for each file
On Error GoTo FileInUseError:
' Make sure it's a PPT file:
If File.Type Like "Microsoft PowerPoint*" Then
10:
Set PPT = Presentations.Open(File.Path, ReadOnly:=msoTrue, WithWindow:=msoFalse)
20:
PPT.Slides.Range.Copy
30:
MasterPPT.Slides.Paste (Total)
PPT.Close
End If
On Error GoTo 0
Total = MasterPPT.Slides.Count
NextFile:
Next File
Next SubFolder
'## It's important to put this before your error-handling block:
Set FSO = Nothing
Set Folder = Nothing
Set SubFolder = Nothing
Set File = Nothing
Exit Sub
FileInUseError:
'## Error handling:
'## Display information about the error
errMsg = "Error No.: " & Err.Number & vbCrLf
errMsg = errMsg & "Description: " & Err.Description & vbCrLf
errMsg = errMsg & "At line #: " & Erl & vbCrLf
errMsg = errMsg & "File.Name: " & File.Name
Debug.Print errMsg & vbCrLf
MsgBox errMsg, vbInformation, "Error!"
Err.Clear
Resume NextFile
End Sub