Problem: Workbook contents vanish

[VanS]

Hello,
I was testing VB code to modify the interface of VBA-programmed Excel
workbooks. Afterwards the two workbooks were shown in their folder and the
interface of one of the worksheets was displayed to the side, but when I
attempt to open either of the two books, Excel app opens but not the specific
workbooks themselves. It just shows the Excel workbook bar at top but empty
of contents. I can open the properties for either of the workbooks and it
shows the Hidden feature is unchecked.
The TaskManager only shows the Excel process but not the Workbook I tried to
open in the Applications window, but under the File Menu it shows the
Workbook present.
Any idea of what happened, and/or how I can get the workbooks to display and
open? (code below)
Thanks, God bless


Option Explicit

Dim exc As EXCEl.Application

Private Sub cmdChange_Click()

strFolder = txtPath.Text
Len(txtPath.Text) - 3)
' get th search path
strPath = strFolder & "\" & "*.xls"
' get the first file with workbook extension
strFile = Dir(strPath, vbNormal)
Do While Len(strFile) <> 0
'booReadOnly = False

If UCase(Left(strFile, 13)) = "EQUIPMENT VOL" Then

If GetAttr(strFolder & "\" & strFile) = vbReadOnly Then
' booReadOnly = True
SetAttr (strFolder & "\" & strFile), vbNormal
End If
'09/20/07 code below original code that worked-commented out to check
for err & added code below it

Set excBk = GetObject(strFolder & "\" & strFile, "Excel.Sheet")

For ndx = 1 To excBk.Worksheets.Count
excBk.Worksheets(ndx).Unprotect

FixLabels ndx '10/27/01
excBk.Worksheets(ndx).Protect

Next ndx 'ndx = 1 To excBk.Application.ActiveWorkbook.Worksheets.Count

excBk.Close savechanges:=True
Set excBk = Nothing '09/27/07
' check for next file
End If

strFile = Dir
Loop



End Sub


Module 1
Option Explicit
Public excBk as EXCEl.Workbook

Public Sub FixLabels(ndx As Integer)


Dim booNegative As Boolean
Dim dblCost As Double
Dim strVal As String
Dim row As Integer
Dim cell As Range


booNegative = False



excBk.Worksheets(ndx).Select
excBk.Worksheets(ndx).Activate

With excBk.Worksheets(ndx).Range("D10")
.HorizontalAlignment = xlHAlignCenter
.Value = "Standard Equipment"
.Font.Size = 10
'.Font.Bold = True
End With

With excBk.Worksheets(ndx).Range("rngReqd")
.HorizontalAlignment = xlHAlignCenter
.Value = "Must Select One from Each Box"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngDesired")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Factory Installed"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngField")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Installed On-Site"
.Font.Size = 10
.Font.Bold = True
End With
' ChangeFormula ndx
row = excBk.Worksheets(ndx).Range("rngTerminusRw").Rows.row

For Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)
booNegative = False
If Not IsEmpty(cell.Value) Then
strVal = cell.Value
If UCase(Right(strVal, 1)) = "X" Then
booNegative = True
strVal = Left(strVal, Len(strVal) - 1)
End If
dblCost = CalcCost(strVal)
strVal = dblCost
strVal = ConvCost(strVal, booNegative)
cell.Value = strVal
End If 'Not IsEmpty(cell.Value) Then
Next 'Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)






End Sub


Public Function CalcCost(strVal As String)
Dim bytLen As Byte
Dim strCents As String
Dim str1000 As String
Dim strDollars As String

strCents = Mid(strVal, 1, 2)
str1000 = Mid(strVal, 3, 1)
strDollars = Mid(strVal, 5)
CalcCost = Val(str1000 & strDollars & "." & strCents)

End Function

Public Function ConvCost(strVal As String, booNegative As Boolean)
Dim bytPeriodPos As Byte
Dim bytLen As Byte
Dim dblCost As Double
Dim strCents As String
Dim str1000 As String
Dim strDollars As String


dblCost = strVal
str1000 = Mid(dblCost, 1, 1)
' get position of decimal point
bytPeriodPos = InStr(Format(dblCost, "Fixed"), ".")
' 43,350.00 -> 400N3350
'4350.50->450N350
'435.75->475N35
'43.50->450N3
'4.30-> 430N

' get length of vals to go after alpha char
' if only one digit bytLen will = 0 and strDollars = ""
' so won't add to concatenation
If bytPeriodPos - 2 > 0 Then
bytLen = bytPeriodPos - 2
End If
strDollars = Mid(dblCost, 2, bytLen)
strCents = Right(Format(dblCost, "Fixed"), 2)
If booNegative Then
ConvCost = (str1000 & strCents & "N" & strDollars & "X")
Else
ConvCost = (str1000 & strCents & "N" & strDollars)
End If
End Function

 

[Ralph]

When you open the workbook select Window frm the Menu Bar then you can Unhide
the workbook. Not sure what causes this, maybe because you are using
GetObject? You have a variable for the Excel application but it is not used.
I changed the code and used the Excel application and it works. I ran the
code in Access so the strFolder reference would be incorrect for your app.

Option Explicit
Dim exc As New Excel.Application
Dim excBk As Excel.Workbook

Public Sub cmdChange_Click()
strFolder = CurrentProject.Path
' get th search path
strPath = strFolder & "\" & "*.xls"
' get the first file with workbook extension
strFile = Dir(strPath, vbNormal)
Do While Len(strFile) <> 0
'booReadOnly = False

If UCase(Left(strFile, 13)) = "EQUIPMENT VOL" Then

If GetAttr(strFolder & "\" & strFile) = vbReadOnly Then
' booReadOnly = True
SetAttr (strFolder & "\" & strFile), vbNormal
End If
'09/20/07 code below original code that worked-commented out to check
for err & added code below it

Set excBk = exc.Workbooks.Open(strFolder & "\" & strFile)

For ndx = 1 To excBk.Worksheets.Count
excBk.Worksheets(ndx).Unprotect

FixLabels ndx '10/27/01
excBk.Worksheets(ndx).Protect

Next ndx 'ndx = 1 To excBk.Application.ActiveWorkbook.Worksheets.Count

excBk.Close savechanges:=True

Set excBk = Nothing '09/27/07
' check for next file
End If

strFile = Dir
Loop
exc.Quit
Set exc = Nothing



End Sub

 

[VanS]

Thanks, Ralph, I'll try it out. Much appreciate your response, God bless,
Van