MS Access VBA EXCEL.EXE not terminating after .quit and = nothing - excel

I'm running code which opens a user provided spreadsheet. It just brings in the first column excluding the header. running the code once works as expected except it leaves the EXCEL.EXE instance open at the end. I've read several questions having this similar problem, all the answers surround finding any object which was not quit/closed and then set to nothing. I do this for every object in my code and even have error checking which catches if it doesn't complete and to quit and clear the objects. On the second run of the code after the EXCEL.EXE doesn't close it throws a "(1004) Application-defined or Object Defined error" on .Cells(Rows.Count, 1).End(xlUp).Row anyone know why that is?
any help would be appreciated
Private Sub SplitImports()
Dim StringVar As Variant
Dim strLn As String
'Asks user for Filepath
StringVar = InputBox("Please enter the file path for your list", "Import", "H:\FNMA_WFDC")
'Ends Function if no input or cancel is detected
MsgBox (StringVar)
If (StringVar = vbNullString) Then
MsgBox ("No input, Please try again")
Quittracker = True
Exit Sub
End If
'Scrubs outer quotes if present
StringVar = Replace(StringVar, Chr(34), "", 1, 2)
'Creates the object to check the file
Dim FSO As Object
Set FSO = CreateObject("Scripting.Filesystemobject")
MsgBox ("Got Passed the FSO Object")
'Checks that our file exists, exits if not
If (Not FSO.FileExists(StringVar)) Then
MsgBox ("File does not exist, try again")
Quittracker = True
Exit Sub
End If
Set FSO = Nothing
Dim xlApp As Object 'Excel.Application
Dim xlWrk As Workbook 'Excel.Workbook
Dim i As Long
Set xlApp = New Excel.Application
MsgBox ("Dimmed the excel objects")
xlApp.Visible = False
On Error GoTo ErrorTrap
Set xlWrk = xlApp.Workbooks.Open(StringVar) 'opens the excel file for processing
MsgBox ("objects are set")
With xlWrk.Worksheets("Sheet1")
.Columns("A").NumberFormat = "#"
MsgBox (.Cells(Rows.Count, 1).End(xlUp).Row)
'walks through the excel sheet to the end and inserts the lines below the headerline into the database
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
DoCmd.RunSQL "Insert Into Split_List(Criteria) values('" & .Cells(i, 1).Text & "')"
Next i
End With
MsgBox ("About to Clear and close the objects")
'closes the workbook and quits the application
xlWrk.Saved = True
xlWrk.Close
Set xlWrk = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox ("End of the import sub")
Exit Sub
ErrorTrap:
xlWrk.Saved = True
xlWrk.Close
Set xlWrk = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox ("(" & Err.Number & ") " & Err.Description
Quittracker = True
Exit Sub

Related

Trying to go through all XLSX files within a folder, unprotect them, change value, and protect them

From MS Access, I am attempting to open every XLSX file within a folder and edit a specific cell within the excel document. However some of these files are protected and some are not. Therefore I am trying to add an IF statement to check for this potential roadblock (I know the password for the protected workbooks and it is consistent across all of them).
I have tried the below code but it keeps returning various errors after every time I alter some of it to work (current error is "Wrong Number of arguments or invalid property):
Private Sub Command0_Click()
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim fso As FileSystemObject
Dim objFolder As Folder
Dim objFile As File
Dim strPath As String
Dim strFile As String
Dim errnum As Long
Dim errtxt As String
'Specify the path to the folder.
strPath = CurrentProject.Path & "\originals"
'***** Set a reference to "Microsoft Scripting Runtime" by using
'***** Tools > References in the Visual Basic Editor (Alt+F11)
'Create an instance of the FileSystemObject.
Set fso = New Scripting.FileSystemObject
'Alternatively, without the reference mentioned above:
'Set fso = CreateObject("Scripting.FileSystemObject")
'Get the folder.
Set objFolder = fso.GetFolder(strPath)
'If the folder does not contain files, exit the sub.
If objFolder.Files.Count = 0 Then
MsgBox "No files found in the specified folder.", vbApplicationModal + _
vbExclamation + vbOKOnly, "Runtime Error"
Exit Sub
End If
'Turn off screen updating. It may run quicker if updating is disabled, but
'if the work to be done is minimal, it may not be necessary.
Set xl = Excel.Application
xl.ScreenUpdating = False
DoCmd.SetWarnings False
'Loop through each file in the folder
For Each objFile In objFolder.Files
strFile = objFile.Path
'Open each file and perform actions on it.
Set wb = xl.Workbooks.Open(objFile.Path)
'Set inline error trap in case PLOG tab does not exist.
On Error Resume Next
Set ws = wb.Worksheets("Whole Foods Market PLOG")
wb.Application.DisplayAlerts = False
errnum = Err.Number
errtxt = Err.Description
On Error GoTo -1
Select Case errnum
Case 0 'Zero = no error.
If ws.ProtectContents = True Then
ws.Unprotect "550" 'enter password
End If
ws.Cells(11, 20).Value = Date
ws.Protect "550", True, True
wb.Save
Case 9 'Subscript out of range; most likely the tab does not exist.
MsgBox "The workbook '" & objFile.Name & "' does not have a 'PLOG' tab."
Case 58
MsgBox "Fix This"
Case 91
Resume Next
Case Else 'All other errors.
MsgBox "Runtime error #" & CStr(errnum) & ": " & IIf(Right(errtxt, 1) = ".", errtxt, errtxt & ".")
End Select
wb.Application.DisplayAlerts = True
wb.Close False
Set wb = Nothing
Next objFile
'Turn screen updating back on
xl.ScreenUpdating = True
'IMPORTANT: Clean up & quit Excel. If this is not done, Excel will stay in memory
'after the macro ends. If this is done repeatedly, many individual instances of Excel
'will build up in memory, and will stay there until killed with an task app such as
'Windows Task Manager or SysInternals ProcessExplorer, or until the system is rebooted,
'and it may even prevent Windows from shutting down properly because all those instances
'of Excel are waiting for user input at the "Save workbook? Yes/No/Cancel" dialog.
xl.Quit
Set xl = Nothing
End Sub
I simply want the code to go through each excel file within the folder and do this:
if the workbook is protected then
unprotect it,
edit cell,
reprotect it,
save/close
if the workbook is not protected then
edit cell,
reprotect it,
save/close
Edit1: fixed a typo I saw in the original code
ws.Unprotect "550", True, True
This would be the "wrong number of arguments". Worksheet.Unprotect takes a single, optional, Password parameter - VBA doesn't know what to do with these two True arguments.
Option Compare Database
Option Explicit
Public Sub SO56995486()
'Declare the variables
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim fso As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.file
Dim fileList As VBA.Collection
Dim fldrPath As String
Dim fullpath As String
Dim filename As String
Dim errnum As Long
Dim c As Long
Dim i As Long
'Specify the path to the folder.
fldrPath = "C:\Temp\"
'Set up a log file.
Open fldrPath & "_logfile.txt" For Output As #1
'***** Set a reference to "Microsoft Scripting Runtime" by using
'***** Tools > References in the Visual Basic Editor (Alt+F11)
'Set up the major object variables.
Set xl = Excel.Application
Set fso = New Scripting.FileSystemObject
Set fileList = New VBA.Collection
'Get the folder.
Set objFolder = fso.GetFolder(fldrPath)
'If the folder does not contain files, exit the sub.
If objFolder.Files.Count = 0 Then
MsgBox "No files found in the specified folder.", vbApplicationModal + _
vbExclamation + vbOKOnly, "Runtime Error"
Exit Sub
End If
'Create a list of all XLSX files in the folder.
For Each objFile In objFolder.Files
filename = objFile.Name
If UCase(fso.GetExtensionName(filename)) = "XLSX" Then
fileList.Add objFile
End If
Next
'Remove any Excel temp files. Tricky loop since items may be deleted.
i = 1
Do
Set objFile = fileList.ITEM(i)
filename = Left(objFile.Name, 2)
If filename = "~$" Then
fileList.Remove (i)
Else
i = i + 1
End If
Loop Until i >= fileList.Count
'Remove any open files. Tricky loop again.
i = 1
Do
Set objFile = fileList.ITEM(i)
fullpath = objFile.Path
If IsFileOpen(fullpath) Then
fileList.Remove (i)
Else
i = i + 1
End If
Loop Until i >= fileList.Count
'Turn off screen updating. It may run quicker if updating is disabled, but
'if the work to be done is minimal, it may not be necessary.
xl.ScreenUpdating = False
DoCmd.SetWarnings False
'Loop through each file in the folder
For Each objFile In fileList
fullpath = objFile.Path
'Open the file. Use inline error trap in case it can't be opened.
On Error Resume Next
Set wb = xl.Workbooks.Open(fullpath)
errnum = Err.Number
On Error GoTo 0
Select Case errnum
Case 0 'File opened ok.
'Use inline error trap in case PLOG tab does not exist.
On Error Resume Next
Set ws = wb.Worksheets("PLOG")
errnum = Err.Number
On Error GoTo 0
Select Case errnum
Case 0 'Tab reference grabbed ok.
If ws.ProtectContents = True Then
ws.Unprotect "550" 'enter password
End If
ws.Cells(11, 20).value = Date
ws.Protect "550", True, True
On Error Resume Next
wb.Save
errnum = Err.Number
On Error GoTo 0
Select Case errnum
Case 0 'Saved ok.
Print #1, "OK: " & objFile.Name
Case Else
Print #1, "Couldn't save: " & objFile.Name
End Select
Case 9 'Subscript out of range; probably tab does not exist.
Print #1, "Tab does not exist: " & objFile.Name
Case Else 'Other errors.
Print #1, "Other error (" & CStr(errnum) & "): " & objFile.Name
End Select
Case Else
Print #1, "Can't open file: "; Tab(20); objFile.Name
End Select
wb.Close True
Set wb = Nothing
Next
'Turn screen updating back on
xl.ScreenUpdating = True
DoCmd.SetWarnings True
'IMPORTANT: Clean up & quit Excel. If this is not done, Excel will stay in memory
'after the macro ends. If this is done repeatedly, many individual instances of Excel
'will build up in memory, and will stay there until killed with an task app such as
'Windows Task Manager or SysInternals ProcessExplorer, or until the system is rebooted,
'and it may even prevent Windows from shutting down properly because all those instances
'of Excel are waiting for user input at the "Save workbook? Yes/No/Cancel" dialog.
xl.Quit
Set xl = Nothing
Close #1
End Sub
Public Function IsFileOpen(filename As String) As Boolean
Dim filenum As Integer
Dim errnum As Integer
On Error Resume Next
filenum = FreeFile()
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
'No error.
IsFileOpen = False
Case 55, 70
'File already open.
IsFileOpen = True
Case Else
'Other error.
'IsFileOpen = ?
End Select
End Function

Word VBA: Update OLE Source Links

I have about a dozen linked excel OLE objects in my word document. These files get moved around the network frequently so I need an easy intuitive way for the underlying links to be updated. I tried a code I found on this website however while it updated the source it seems to also update what is being shown in the object itself so all the objects change to whatever worksheet was in focus when the excel workbook was saved last. I'm trying to retain format and range while updating the source. Any help would be great.
Here is the code I tried presently:
Private Sub CommandButton1_Click()
Dim OldFile As String
Dim xlsobj As Object
Dim xlsfile_chart As Object
Dim dlgSelectFile As FileDialog 'FileDialog object '
Dim thisField As Field
Dim selectedFile As Variant
'must be Variant to contain filepath of selected item
Dim newFile As Variant
Dim fieldCount As Integer '
Dim x As Long
On Error GoTo LinkError
'create FileDialog object as File Picker dialog box
Set dlgSelectFile = Application.FileDialog
(FileDialogType:=msoFileDialogFilePicker)
With dlgSelectFile
.Filters.Clear 'clear filters
.Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm,*.xlsx" 'filter
for only Excel files
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
'step through each string in the FileDialogSelectedItems collection
For Each selectedFile In .SelectedItems
newFile = selectedFile 'gets new filepath
Next selectedFile
Else 'user clicked cancel
Exit Sub
End If
End With
Set dlgSelectFile = Nothing
'update fields
Set xlsobj = CreateObject("Excel.Application")
xlsobj.Application.Visible = False
Set xlsfile_chart = xlsobj.Application.Workbooks.Open(newFile, ReadOnly =
True)
Application.ScreenUpdating = False
With xlsobj.Application
.calculation = xlcalculationmanual
.enableevents = False
End With
fieldCount = ActiveDocument.Fields.Count
For x = 1 To fieldCount
With ActiveDocument.Fields(x)
If .Type = 56 Then
.LinkFormat.SourceFullName = newFile
End If
End With
Next x
With xlsobj.Application
.calculation = xlcalculationmanual
.enableevents = True
End With
Application.ScreenUpdating = True
MsgBox "Data has been sucessfully linked to report"
'clean up
xlsfile_chart.Close SaveChanges:=False
Set xlsfile_chart = Nothing
xlsobj.Quit
Set xlsobj = Nothing
Exit Sub
LinkError:
Select Case Err.Number
Case 5391 'could not find associated Range Name
MsgBox "Could not find the associated Excel Range Name " & _
"for one or more links in this document. " & _
"Please be sure that you have selected a valid " & _
"Quote Submission input file.", vbCritical
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
End Select
' clean up
Set xlsfile_chart = Nothing
xlsobj.Quit
Set xlsobj = Nothing
End Sub

Return Excel Row in Word Macro

I have ContentControl drop down box in Word. Once I select an item from a Drop Down list I want to search for that in an Excel document and set the row number equal to a variable.
The code below is what I tried but the Columns("G:G").Find part says its not defined.
Sub findsomething(curRow)
Dim rng As Range
Dim rownumber As Long
curPath = ActiveDocument.path & "\"
Call Set_Variable(curPath)
StrWkShtNm = "Chapters"
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
Set rng = Columns("G:G").Find(what:=curRow)
rownumber = rng.Row
MsgBox rownumber
' Release Excel object memory
Set xlWkBk = Nothing
Set xlApp = Nothing
Application.ScreenUpdating = True
End Sub
While using more than one MS Office application it is a good idea to specify which application you are targeting:
Excel.Application.ThisWorkbook.Sheets(1).Range("A1").Select
this is what ended up working. you set me on the right track with referencing Excel.
Sub findsomething(curRow)
Dim rng As Long
Dim rownumber As Long
curPath = ActiveDocument.path & "\"
Call Set_Variable(curPath)
StrWkShtNm = "Chapters"
MsgBox "curRow = " & curRow
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
With xlApp
.Visible = False
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMRU:=False)
With xlWkBk
With .Worksheets(StrWkShtNm)
rng = .Range("G:G").Find(what:=curRow)
MsgBox rng
End With
.Close False
End With
.Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
Application.ScreenUpdating = True
End Sub

Access - open Excel file, do some coding with It and close

I'm trying to open an Excel file from Access and do some stuff with It, but code is not stable. Sometimes It works, other times not. Here's how I do this:
Dim FilePath As String
Dim ExcelApp As Excel.Application
FilePath = "C:\Users\Lucky\Desktop\Test.xls"
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Workbooks.Open (FilePath)
With ExcelApp
'do some stuff here
End With
ExcelApp.Workbooks.Close
Set ExcelApp = Nothing
I've also noticed that once I run code, Excel starts proccess under Task Manager, that has to be killed manually in order to get code working again. Otherwise I get two types of error with Excel file:
one is that If I click Excel file, It doesn't open, It just flashes for a second and dissapears
and other is that Excel file opens in "read-only" mode...
So I reckon there is some flaw when file is closed in my code. How can I fix this ?
I can't see what's wrong with your code - maybe the path to the desktop?
This is the code I usually use - I've added another function to help choose the file. It uses late binding, so no need to set a reference to Excel - you don't get the IntelliSense and can't use Excel constants such as xlUp - you have to use the numerical equivalent.
Public Sub Test()
Dim oXLApp As Object
Dim oXLWrkBk As Object
Dim oXLWrkSht As Object
Dim vFile As Variant
Dim lLastRow As Long
vFile = GetFile()
Set oXLApp = CreateXL
Set oXLWrkBk = oXLApp.WorkBooks.Open(vFile, False)
Set oXLWrkSht = oXLWrkBk.WorkSheets(1) 'First sheet. Can also use "Sheet1", etc...
lLastRow = oXLWrkSht.Cells(oXLWrkSht.Rows.Count, "A").End(-4162).Row '-4162 = xlUp
MsgBox "Last row in column A is " & lLastRow
oXLWrkBk.Close False
oXLApp.Quit
Set oXLWrkBk = Nothing
Set oXLApp = Nothing
End Sub
Public Function CreateXL(Optional bVisible As Boolean = True) As Object
Dim oTmpXL As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Defer error trapping in case Excel is not running. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Set oTmpXL = GetObject(, "Excel.Application")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'If an error occurs then create an instance of Excel. '
'Reinstate error handling. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Err.Number <> 0 Then
Err.Clear
On Error GoTo ERROR_HANDLER
Set oTmpXL = CreateObject("Excel.Application")
End If
oTmpXL.Visible = bVisible
Set CreateXL = oTmpXL
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure CreateXL."
Err.Clear
End Select
End Function
Function GetFile(Optional startFolder As Variant = -1, Optional sFilterName As String = "") As Variant
Dim fle As Object
Dim vItem As Variant
'''''''''''''''''''''''''''''''''''''''''''
'Clear the file filter and add a new one. '
'''''''''''''''''''''''''''''''''''''''''''
Application.FileDialog(3).Filters.Clear
Application.FileDialog(3).Filters.Add "'Some File Description' Excel Files", "*.xls, *.xlsx, *.xlsm"
Set fle = Application.FileDialog(3)
With fle
.Title = "Select a file"
.AllowMultiSelect = False
If startFolder = -1 Then
.InitialFileName = CurrentProject.Path
Else
If Right(startFolder, 1) <> "\" Then
.InitialFileName = startFolder & "\"
Else
.InitialFileName = startFolder
End If
End If
If .Show <> -1 Then GoTo NextCode
vItem = .SelectedItems(1)
End With
NextCode:
GetFile = vItem
Set fle = Nothing
End Function
I have managed to solve my problem. There is nothing wrong with code in my question, except that instead of declaring
Dim ExcelApp As Excel.Application
It's better to use
Dim ExcelApp As Object
But much bigger problem is with code that does changes in Excel, such as this line:
x = Range(Cells(1, i), Cells(Rows.Count, i).End(xlUp)).Value
And correct synthax is:
x = ExcelApp.Range(ExcelApp.Cells(1, i), ExcelApp.Cells(ExcelApp.Rows.Count, i).End(xlUp)).Value 'maybe also better to replace xlUp with -4162
So, whenever you use some code for Excel file from Access, DON'T FORGET to reference everything to Excel object. And ofcourse, before everything, a proper reference must be set in VBA console, in my case Microsoft Office 15.0 library.

ItemAdd Event in Outlook Using VBA - Something Causing Listeners to 'UnSet' Randomly

I am using VBA with an event listener on a specific sub-folder to run a macro when that folder receives an email. It is working perfectly, with one exception. I am setting the objects to listen, but they are getting set back to 'nothing' seemingly randomly, which stops the listeners from 'listening'. Here's the code I am using to set the listeners and trigger the macros:
Public WithEvents myOLItems As Outlook.Folder
Public WithEvents myTDLoanEmails As Outlook.Items
Private Sub Application_Startup()
Set myOLItems = Outlook.Session.GetDefaultFolder(olFolderInbox)
Set myTDLoanEmails = myOLItems.Folders("Trust Loan Collateral Tracking Text Files").Items
End Sub
Private Sub myTDLoanEmails_ItemAdd(ByVal Item As Object)
Call getAttachments
Call runTextToExcel
End Sub
'runTextToExcel' creates an Excel application, opens an Excel file, runs a macro in that file, and then closes the file and the application. I think the error may be stemming from the file/Excel application not closing completely, because if I run the Outlook macro again immediately after completion, it cannot find the Excel file, despite the fact that hasn't moved. This causes an error, which I think may be 'unsetting' the listeners. Is this possible?
If it helps (or you're curious) here are the two subs that are called above:
Private Sub runTextToExcel()
Dim xlApp As Object
Dim oWbk As Workbook
Dim TextToExcelFile As Workbook
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
End With
sFile = "Loan Text Files to Excel Converter_v004.xlsm"
sPath = "K:\Shared\Text to Excel\"
bOpened = False
For Each oWbk In Workbooks
If oWbk.Name = sFile Then bOpened = True
Next oWbk
If bOpened = False Then Workbooks.Open (sPath & sFile)
xlApp.Run "'" & sFile & "'!LoanTextFilesToExcel"
xlApp.DisplayAlerts = False
Workbooks(sFile).Close (True)
xlApp.DisplayAlerts = True
xlApp.Quit
End Sub
Private Sub getAttachments()
On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim TDLoanEmails As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set TDLoanEmails = Inbox.Folders("Trust Loan Collateral Tracking Text Files")
For Each Item In TDLoanEmails.Items
If Item.Attachments.Count > 3 Then
If Day(Item.ReceivedTime) = Day(Date) And Month(Item.ReceivedTime) = Month(Date) And Year(Item.ReceivedTime) = Year(Date) Then
For Each Atmt In Item.Attachments
If Right(Atmt.FileName, 4) = ".TXT" Then
FileName = "K:\Shared\Text to Excel\Text Files\" & Left(Atmt.FileName, Len(Atmt.FileName) - 4) & "-" & Format(Date, "mmddyyyy") & ".txt"
Atmt.SaveAsFile FileName
End If
Next Atmt
End If
End If
Next Item
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
End Sub
Thanks!
Not sure if it is because of the runTextToExcel But take a backup of your existing runTextToExcel and replace it with this.
I believe you are using Late Binding
Changes made in this code
Object Declared
Object Closed and Released properly
Code
Private Sub runTextToExcel()
Dim xlApp As Object
Dim oWbk As Object, wb As Object
Dim TextToExcelFile As Object '<~~ Are you using this anywhere?
Dim bOpened As Boolean
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
End With
sFile = "Loan Text Files to Excel Converter_v004.xlsm"
sPath = "K:\Shared\Text to Excel\"
bOpened = False
For Each oWbk In xlApp.Workbooks
If oWbk.Name = sFile Then bOpened = True
Next oWbk
If bOpened = False Then Set wb = xlApp.Workbooks.Open(sPath & sFile)
xlApp.Run "'" & sFile & "'!LoanTextFilesToExcel"
xlApp.DisplayAlerts = False
wb.Close (True)
xlApp.DisplayAlerts = True
xlApp.Quit
Set wb = Nothing
Set xlApp = Nothing
End Sub

Resources