Excel Application Read Only

  • Thread starter Thread starter Martin
  • Start date Start date
M

Martin

Forgive me if this is considered a double post. I could not find my post
from a few weeks ago to continue that one.

I posted a question a few weeks ago about why Excel would remain open with
the spreadsheet file in read-only mode. It was suggested then that I fully
qualify all my references to the Excel application and file. I believe I
have done that, but I still end up with Excel running in read-only mode.

The problem occurs regardless of whether Excel is already running or not. I
always get a message box titled "File Now Available" with options to Cancel
or Read/Write. Even if I Cancel here, the spreadsheet still remains open.

The code I am using is posted below. Can anyone offer any suggestions to
stop this?

Thanks.

=========start of code
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")

xlApp.Workbooks.Open FileName:=HRFileName

'If number of worksheets is not as expected
If xlApp.Worksheets.Count <> HRWkstCount Then
Mess1 = "The number of worksheets in " & UCase(HRFile) & _
" is not " & HRWkstCount
Mess2 = "Check the file for proper format"
Mess3 = "Processing will be aborted"
MessAll = Mess1 & vbCrLf & vbCrLf & Mess2 & vbCrLf & Mess3
MsgBox MessAll, vbOKOnly, "HR FILE FORMAT PROBLEM"
GoTo CleanUp
End If

'Find and compare first data row in HR file.
FirstDataRow = 0
FirstRowCheck = 0
For Y = 1 To HRWkstCount
xlApp.Worksheets(Y).Select
xlApp.Range("B1").Select
For X = 1 To 10
If xlApp.ActiveCell.Value <> "" Then
FirstRowCheck = xlApp.ActiveCell.Row + 1
Exit For
End If
xlApp.ActiveCell.Offset(1, 0).Select
Next X
If Y = 1 Then
FirstDataRow = FirstRowCheck
End If
If FirstRowCheck <> FirstDataRow Then
Mess1 = "The pages of HR data do not start on the same row"
Mess2 = "Check the file for proper format"
Mess3 = "Processing will be aborted"
MessAll = Mess1 & vbCrLf & vbCrLf & Mess2 & vbCrLf & Mess3
MsgBox MessAll, vbOKOnly, "HR FILE FORMAT PROBLEM"
GoTo CleanUp
End If
Next Y

'Check to be sure all SSNs are numbers, not labels
FileBadSSNCount = 0
For Y = 1 To HRWkstCount
SheetBadSSNCount = 0
xlApp.Worksheets(Y).Select
xlApp.Range("B" & FirstRowCheck).Select
xlApp.Selection.End(xlDown).Select
Last_Row = xlApp.ActiveCell.Row
xlApp.Range("A" & FirstRowCheck).Select

For X = FirstRowCheck To Last_Row
If IsNumeric(xlApp.ActiveCell.Value) = vbFalse Then
SheetBadSSNCount = SheetBadSSNCount + 1
FileBadSSNCount = FileBadSSNCount + 1
End If
xlApp.ActiveCell.Offset(1, 0).Select
Next X

BadSSNArray(Y - 1, 0) = xlApp.ActiveSheet.Name
BadSSNArray(Y - 1, 1) = SheetBadSSNCount

Next Y

If FileBadSSNCount <> 0 Then
Mess1A = ""
For Z = 0 To HRWkstCount - 1
Mess1A = Mess1A & " Tab: " & BadSSNArray(Z, 0) & _
" Count: " & BadSSNArray(Z, 1) & vbCrLf
Next Z
Mess1 = "There are " & FileBadSSNCount & " invalid SSN values"
Mess2 = "Check the file for proper format"
Mess3 = "Processing will be aborted"
MessAll = Mess1 & vbCrLf & Mess1A & vbCrLf & Mess2 & vbCrLf &
Mess3
MsgBox MessAll, vbOKOnly, "HR FILE FORMAT PROBLEM"
GoTo CleanUp
End If

For Z = 1 To HRWkstCount
'Select worksheet tab of HR file
xlApp.Worksheets(Z).Select
'Store facility name/tab name for later use
FacName = xlApp.ActiveSheet.Name
xlApp.Range("A" & FirstDataRow).Select
xlApp.Selection.End(xlDown).Select
'Store last row of data
Last_Row = xlApp.ActiveCell.Row

'Create address range of data to import
CellRange = FacName & "!A" & FirstDataRow - 1 & ":G" & _
Last_Row
'Import data from spreadsheet
DoCmd.TransferSpreadsheet acImport, , "W_HRImport", HRFileName, _
True, CellRange

Next Z

'Close HR File
xlApp.Workbooks(HRFile).Close False

CleanUp:
' Close Excel
xlApp.Quit
Set xlApp = Nothing

=========end of code
 
Written in notepad, but I think I got it. You need to break it down a little
more than you are.
Check out this link:
http://www.tushar-mehta.com/excel/vba/xl_doesnt_quit/

Try:

Dim xlApp As Excel.Application
dim xlWb as Excel.Workbook
dim xlWs as Excel.worksheet
Set xlApp = CreateObject("Excel.Application")

set xlwb=xlApp.Workbooks.Open FileName:=HRFileName

'If number of worksheets is not as expected
If xkwb.Worksheets.Count <> HRWkstCount Then
Mess1 = "The number of worksheets in " & UCase(HRFile) & _
" is not " & HRWkstCount
Mess2 = "Check the file for proper format"
Mess3 = "Processing will be aborted"
MessAll = Mess1 & vbCrLf & vbCrLf & Mess2 & vbCrLf & Mess3
MsgBox MessAll, vbOKOnly, "HR FILE FORMAT PROBLEM"
xlwb.close
GoTo CleanUp
End If

'Find and compare first data row in HR file.
FirstDataRow = 0
FirstRowCheck = 0
For Y = 1 To HRWkstCount
set xlws =xlwb.Worksheets(Y).Select
xlws.Range("B1").Select
For X = 1 To 10
If xlws.ActiveCell.Value <> "" Then
FirstRowCheck = xlws.ActiveCell.Row + 1
Exit For
End If
xlws.ActiveCell.Offset(1, 0).Select
Next X
If Y = 1 Then
FirstDataRow = FirstRowCheck
End If
If FirstRowCheck <> FirstDataRow Then
Mess1 = "The pages of HR data do not start on the same row"
Mess2 = "Check the file for proper format"
Mess3 = "Processing will be aborted"
MessAll = Mess1 & vbCrLf & vbCrLf & Mess2 & vbCrLf & Mess3
MsgBox MessAll, vbOKOnly, "HR FILE FORMAT PROBLEM"
GoTo CleanUp
End If
Next Y

'Check to be sure all SSNs are numbers, not labels
FileBadSSNCount = 0
For Y = 1 To HRWkstCount
SheetBadSSNCount = 0
set xlws =xlwb.Worksheets(Y).Select
xlws.Range("B" & FirstRowCheck).Select
xlws.Selection.End(xlDown).Select
Last_Row = xlws.ActiveCell.Row
xlws.Range("A" & FirstRowCheck).Select

For X = FirstRowCheck To Last_Row
If IsNumeric(xlws.ActiveCell.Value) = vbFalse Then
SheetBadSSNCount = SheetBadSSNCount + 1
FileBadSSNCount = FileBadSSNCount + 1
End If
xlws.ActiveCell.Offset(1, 0).Select
Next X

BadSSNArray(Y - 1, 0) = xlws.Name
BadSSNArray(Y - 1, 1) = SheetBadSSNCount

Next Y

If FileBadSSNCount <> 0 Then
Mess1A = ""
For Z = 0 To HRWkstCount - 1
Mess1A = Mess1A & " Tab: " & BadSSNArray(Z, 0) & _
" Count: " & BadSSNArray(Z, 1) & vbCrLf
Next Z
Mess1 = "There are " & FileBadSSNCount & " invalid SSN values"
Mess2 = "Check the file for proper format"
Mess3 = "Processing will be aborted"
MessAll = Mess1 & vbCrLf & Mess1A & vbCrLf & Mess2 & vbCrLf &
Mess3
MsgBox MessAll, vbOKOnly, "HR FILE FORMAT PROBLEM"
GoTo CleanUp
End If

For Z = 1 To HRWkstCount
'Select worksheet tab of HR file
set xlws=xlwb.Worksheets(Z).Select
'Store facility name/tab name for later use
FacName = xlws.Name
xlws.Range("A" & FirstDataRow).Select
xlws.Selection.End(xlDown).Select
'Store last row of data
Last_Row = xlws.ActiveCell.Row

'Create address range of data to import
CellRange = FacName & "!A" & FirstDataRow - 1 & ":G" & _
Last_Row
'Import data from spreadsheet
DoCmd.TransferSpreadsheet acImport, , "W_HRImport", HRFileName, _
True, CellRange

Next Z

'Close HR File
xlwb.Close False
CleanUp:
' Close Excel
on error resume next
set xlws=nothing
set xlwb=nothing
xlApp.Quit
Set xlApp = Nothing
 
Sorry, I got these lines are wrong
set xlws =xlwb.Worksheets(Y).Select
should be
set xlws =xlwb.Worksheets(Y)
 
Your suggestions worked for me. The only thing I had to do was to add
another "layer" for the Excel Range. None of the lines that I used
ActiveCell would execute(even though they compiled). The only way that made
sense was to add Dim xlRng = Excel.Range and add/change apprpriate Set
statements.

Thanks for the help.
 
Back
Top