Opening some workbooks with a Macro renames them

[Greg Glynn]

I have a macro which opens and reads about 90 workbooks in a
directory. There a 5 workbooks out of the 90 which, when opened,
rename themselves by appending a digit to the end of the workbook
name.

That is:
070218 Fred Smith.xls
gets opened as
070218 Fred Smith1.xls

I can't see what is different about these 5 out of 90, which will not
allow them to be opened without renaming. If I open them manually, I
don't have this problem.

The code is:

X = "070218"

With Application.FileSearch
.NewSearch
.LookIn = ProcessedFolder
.Filename = x & "*.XLS"
.SearchSubFolders = False
.Execute

For i = 1 To .FoundFiles.Count

For Each r In Range("A2:A500") 'This is a range in another
workbook .. this is working OK
If Trim(r) <> "" Then 'Process only non-blank cells
If InStr(.FoundFiles(i), r) > 0 Then
Workbooks.Open .FoundFiles(i), ReadOnly:=True
wbfilename = Mid(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") +
1, 200)
Application.StatusBar = "Processing " & wbfilename
r.Offset(0, 2) = Workbooks(wbfilename).Sheets("Charge
Sheet").Range("CS_ThisVersion").Value '<=== Fails here with Error 9
- Subscript out of Range
Workbooks(wbfilename).Close SaveChanges:=False
End If
End If
Next r
Next i
End With

The macro fails at
r.Offset(0, 2) = Workbooks(wbfilename).Sheets("Charge
Sheet").Range("CS_ThisVersion").Value
... with a subscipt out of range error (because the wbfilebame
variable is no longer the same as the short file name due to the
renaming).

Does anyone know what would force a spreadsheet to open renamed? I
happens to the same 5 workbooks, so I think it is file attribute or
file name related but my investigations don't show any obvious
differences.


Greg

 

[Charles Chickering]

That is quite odd, I don't know how to fix the problem but I might be able to
help you work around it. Try setting a workbook variable to the workbook you
are opening, this will allow you to access it regardless of the name:
Dim wb As Workbook
Set wb = Workbooks.Open .FoundFiles(i), ReadOnly:=True
r.Offset(,2) = _
wb.Worksheets("Change Sheet").Range("CS_ThisVersion")

HTH

 

[Alan]

Are you sure it is an xls file? If it is opening with a 1 it is a template
file. Are you using * wildcards for your file extension when looping through
the workbooks?

Regards,

Alan

 

[Greg Glynn]

That is quite odd, I don't know how to fix the problem but I might be able to
help you work around it. Try setting a workbook variable to the workbook you
are opening, this will allow you to access it regardless of the name:
Dim wb As Workbook
Set wb = Workbooks.Open .FoundFiles(i), ReadOnly:=True
r.Offset(,2) = _
wb.Worksheets("Change Sheet").Range("CS_ThisVersion")

HTH
--
Charles Chickering

"A good example is twice the value of good advice."















- Show quoted text -

Charles,

Excellent suggestion, and that does work, but I have another process
in another part of the application which moves the file from one
directory to another, so your suggestion wont work, because I still
have the original problem. I'm starting to think that it may be a
file corruption or a problem caused by saving the orginal template
file with various versions of Excel.

Maybe it's a data corruption. It's driving me batty though.

 

[Greg Glynn]

Alan,

They are all .XLS files but perhaps there is a corruption that makes
these files THINK their XLT files (I'm guessing here, but you never
know). I'll retype the data in one witha fresh template and see how
we go.

Regards


Greg

 

[JLGWhiz]

Maybe I am reading the code wrong, but when you create a new name for an open
workbook, shouldn't it be saved before using the new name as an object?

 

[Greg Glynn]

Hi Whiz,

Thanks for having a look ... I haven't posted the whole code:
There's another workbook already open when the code gets this far, so
the code reads the newly opened worksheets, gets the CS_ThisVersion
value, and stores it in the already opened "results" worksheet.

The more I look in to this, I'm finding that it's more than likely
something whacky with the way the users are (a) loading the Template
or (b) saving it.

Long Story Short: It looks like USER ERROR

If I figure out how their circumventing the save routines, I'll post
the results back here, because there is certainly something unusual
about how "The Gang of 5" are saving their workbooks.

Regards


Greg

 

[Greg Glynn]

I found the process that is causing the problem, but not the Root
Cause.

It turns out that if a user clicks on the Excel Toolbar "SAVE" icon
(like we all do) instead of clicking the Save Button that is included
on my application, then reopening this file with a Workbooks.open
command causes the renaming. Why? Don't know!

My workaround is to disable the Save and Save as functions in Excel
while the Workbook in question has focus (is active).

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
' If the Chargesheet is Active (in focus), disable Save(3) and
SaveAs(748)
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=3)
Ctrl.Enabled = False
Next Ctrl

For Each Ctrl In Application.CommandBars.FindControls(ID:=748)
Ctrl.Enabled = False
Next Ctrl
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
' If the Chargesheet is Not Active (in focus), enable Save(3) and
SaveAs(748)
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=3)
Ctrl.Enabled = True
Next Ctrl

For Each Ctrl In Application.CommandBars.FindControls(ID:=748)
Ctrl.Enabled = True
Next Ctrl
End Sub

Maybe I should report the problem the Microsoft.

The SAVE Routine I'm using looks like this (just in case anyone out
there can spot an error in the code).

Private Sub SaveMe_Click()

'------------------------------------------------
' save charge sheet with a default name and date

On Error Resume Next

Dim FileSavename As Variant
Dim SuggestedName As String

Dim ThisWEString As String
'----------------------------------------------------
' cannot save charge sheet with no name, date or team

With ActiveSheet
MyName = .Range("CS_MyName").Value
MyTeam = .Range("CS_MyTeam").Value
ThisWEString = .Range("CS_MyWE").Value
End With

If MyName = "" Or MyTeam = "" Or Not IsDate(ThisWEString) Then

'
IntResult = MsgBox("Please complete Name, Team and Week before
saving the Charge Sheet", _
vbExclamation, "Charge Sheet Processing")

Exit Sub

End If

'------------------------------------------------
' suggested name is staff name and date

With ActiveSheet

SuggestedName = _
Format(.Range("CS_MyWE"), "yymmdd ") & .Range("CS_MyTeam") & " "
& .Range("CS_Myname") & ".xls"

End With

show_dialog:

IntResult = vbYes ' default is overwrite

FileSavename = Application.GetSaveAsFilename( _
"x:\Charge Sheets\1. Collection Point\" & SuggestedName,
Filefilter:="Excel Workbook (*.xls),*.xls", _
Title:="Save Charge Sheet file as . . .")

'---------------------------------------------

If FileSavename = "False" Then Exit Sub 'User pressed Cancel on
the SaveAs dialog

If Dir(FileSavename) <> "" Then _

IntResult = MsgBox("A file named " & FileSavename & " already"
& _
" exists in this location." & vbCrLf & vbCrLf & _
"Do you want to replace it?" & vbCrLf _
, vbYesNo + vbExclamation, "Charge Sheet
Processing")
End If

'Take action based on intResult
Select Case IntResult

Case Is = vbYes

' write username and save date on the sheet

With ActiveSheet
.Unprotect Password:=SheetPW

.Range("CS_User").Value = Environ("UserName")
.Range("CS_SaveDate").Value = Format(Now, "d-mmm-yy
hh:mm")

' set processed flag to blank ??
.Range("CS_Flag").Value = ""

.Protect Password:=SheetPW

End With

' now save it

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileSavename
Application.DisplayAlerts = True

IntResult = MsgBox(FileSavename & " saved.", vbInformation, _
"Charge Sheet Processing")


Case Is = vbNo

Exit Sub

End Select

Exit Sub
End Sub