Error if File Open

[Neon520]

Hi Everyone,

Thanks to Joel, I have a code to open All Files in one folder to extract the
data from.

However, Debugging Error will occur if any of the file in That folder remain
open, regardless of any changes made and/or user save the changes or not.
Is there a way to code so that there will an ERROR MESSAGE BOX appear when
any of the file in That folder is open. Then the user can click ok and then
close the file manually.

I know there must be a way to force save the opened file and proceed with
whatever is next, but this way might force save any unintended changes save
to it. So I rather prefer it to be manual instead.

Thanks for any help.

Neon520

 

[Barb Reinhardt]

Please provide your code and we can assist in fixing it.

Barb Reinhardt

 

[Chip Pearson]

Try some code like the following. Change the FolderName line marked
with <<< to the appropriate folder. The code will open all the files
in that folder. If a file is already open, the user is prompted to
close and re-open the file (vbYes), skip the file and leave it open
(vbNo) or terminate the entire operation (vbCancel).

Sub OpenFiles()

Dim WB As Workbook
Dim FName As String
Dim SaveDir As String
Dim FolderName As String
Dim Res As VbMsgBoxResult

FolderName = "C:\SiteStats" '<<< CHANGE
ChDrive FolderName
ChDir FolderName
FName = Dir("*.xls")
On Error Resume Next
Do Until FName = vbNullString
Err.Clear
Set WB = Nothing
Set WB = Workbooks(FName)
If Err.Number = 0 Then
' workbook already open
Res = MsgBox("The file '" & FName & "' is already open." &
vbCrLf & _
"Click 'Yes' to close and re-open the workbook." &
vbCrLf & _
"Click 'No' to skip this workbook and leave the
existing version open." & vbCrLf & _
"Click 'Cancel' to terminate the operation.",
vbYesNoCancel, "Open Workbooks")
Select Case Res
Case vbYes
Workbooks(FName).Close savechanges:=True
Case vbNo
' do nothing
Case vbCancel
Exit Sub
End Select
Else
Application.Workbooks.Open FName
Debug.Print "OPEN: " & FName
End If
FName = Dir()
Loop
ChDrive SaveDir
ChDir SaveDir


End Sub

Cordially,
Chip Pearson
Microsoft MVP
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Neon520]

Here is my code Barb,
I'm using Office 2004 for Mac, the directory to open file is slightly
different from Office for Window.

' Transfer Macro
'
' Keyboard Shortcut: Option+Cmd+x
'

Mymonth = InputBox("Enter Name of Month (ALL CAPS): ")

Set NewSht = ThisWorkbook.ActiveSheet

Folder = "Users:Neonesktop:TEST FOLDER:"
FName = Dir(Folder, MacID("XLS8"))

'MsgBox ("Found file:" & FName)
Newrowcount = 2
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
'MsgBox ("check Sheet : " & Sht.Name)
With Sht
Oldrowcount = 7
Do While .Range("B" & Oldrowcount) <> ""
If UCase(.Range("B" & Oldrowcount)) = Mymonth Then
'Range("B7:B38").Copy
'Range("D1").PasteSpecial Paste:=xlPasteValues
.Rows(Oldrowcount).Copy _
Destination:=NewSht.Rows(Newrowcount)
'NewSht.Range("A" & Newrowcount) = .Range("A" & Oldrowcount)
'NewSht.Range("B" & Newrowcount) = .Range("B" & Oldrowcount)
'NewSht.Range("C" & Newrowcount) = .Range("C" & Oldrowcount)
'NewSht.Range("D" & Newrowcount) = .Range("D" & Oldrowcount)
Newrowcount = Newrowcount + 1
End If
Oldrowcount = Oldrowcount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()
'MsgBox ("Found file : " & FName)
Loop

End Sub

Thank you,
Neon520

 

[Neon520]

Hi Pearson,

Please see the code that I posted for Barb on the same thread.

I copied your code right after: Set NewSht = ThisWorkbook.ActiveSheet
and I replace the folder directory just as you instructed; however, there is
one section of the code that turn RED:

Res = MsgBox("The file '" & FName & "' is already open." &
vbCrLf & _
"Click 'Yes' to close and re-open the workbook." &
vbCrLf & _
"Click 'No' to skip this workbook and leave the
existing version open." & vbCrLf & _
"Click 'Cancel' to terminate the operation.",
vbYesNoCancel, "Open Workbooks")

And when I run it, here is the Error message I got:

Complie error:
Automation type not supported in Visual Basic

Any idea?
FYI, I'm using Office 2004 for Mac OSX.

Thank you,
Neon520