最近、Oracleに関連する投稿ばかりしてましたが、Oracleと同時並行で行っているExcel VBAの開発時において、あるPCのみでエラーが発生する現象にブチ当たり、Webで調べたところ、他にも同じような例があったのですが、解決策が掲載されていなかったので、書くことにします。
不具合の起こったPC
OS:Windows 2000, Excel 2003
以下が、おそらくVBAの不具合が原因だと思われるエラーの起こる箇所です。
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path & "..フォルダ名"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
' フォルダ内に適切なファイルが存在するかチェック
If .Execute() = 0 Then
MsgBox "適切なオーダファイルが「オーダ」フォルダ内に存在しません。", vbInformation, "検索結果"
Exit Sub
End If
End With
エラーの内容ですが、Filesearchで検索しに行くフォルダ内のファイルが存在していても、ファイルがないと認識したり、削除したはずのファイルを検索してしまうという内容です。これの原因は、ファイル移動等行った際にOSによりファイルのパスがショートカットとして残されていて、あるタイミングでクリーンにされるのが原因なんじゃないかと思います。同様のバグがこちらにも報告されていますので、リンクします。
http://www.asahi-net.or.jp/~zn3y-ngi/YNxv9192.html
色々書いてありますが、結果的な結論は書いてありません。
結論から言えば、Filesearchは使ってはいけません。その代わりに、自分は＠ITのこちらのページhttp://www.atmarkit.co.jp/fwin2k/win2ktips/310filelist/filelist.htmlと、このページに掲載されているサンプルVBAプログラムを参考に、以下のように作り直しました。
Dim objFs As Object
Dim objFl As Object
Dim objFld As Object
Dim FoundFileCount As Integer ' 検索ファイル数
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFld = objFs.GetFolder(ThisWorkbook.Path & "..フォルダ名")
FoundFileCount = 0 ' 初期化
For Each objFl In objFld.Files
If (objFl.Type = "Microsoft Excel ワークシート") Then
FoundFileCount = FoundFileCount + 1
' フォルダ内のExcelを一つずつ開く
Set wb_OrderFile = Workbooks.Open(objFl.Path)
ActiveSheet.Copy before:=DummyWB.Sheets(FoundFileCount)
wb_OrderFile.Close
Label1.Caption = Int(FoundFileCount / objFld.Files.Count * 100)
DoEvents ' ラベル更新のため
End If
Next
If FoundFileCount = 0 Then
MsgBox "適切なファイルがフォルダ内に存在しません。", vbInformation, "検索結果"
OpeningMessage.Hide
Exit Sub
End If
フォームも使うプログラムなんで、ちょこちょこ不要な部分もありますが、要はWindows Scriptを使用するということです。FindFirstFile関数のようなAPIも使用しないし、コーディングが容易にできます。但し、古いPCでこのWindows Scriptが使用できるかどうかは定かではありませんが、少なくとも、Win2000とWinXPでは動作します☆
ご参考になれば幸いです。
不具合の起こったPC
OS:Windows 2000, Excel 2003
以下が、おそらくVBAの不具合が原因だと思われるエラーの起こる箇所です。
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path & "..フォルダ名"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
' フォルダ内に適切なファイルが存在するかチェック
If .Execute() = 0 Then
MsgBox "適切なオーダファイルが「オーダ」フォルダ内に存在しません。", vbInformation, "検索結果"
Exit Sub
End If
End With
エラーの内容ですが、Filesearchで検索しに行くフォルダ内のファイルが存在していても、ファイルがないと認識したり、削除したはずのファイルを検索してしまうという内容です。これの原因は、ファイル移動等行った際にOSによりファイルのパスがショートカットとして残されていて、あるタイミングでクリーンにされるのが原因なんじゃないかと思います。同様のバグがこちらにも報告されていますので、リンクします。
http://www.asahi-net.or.jp/~zn3y-ngi/YNxv9192.html
色々書いてありますが、結果的な結論は書いてありません。
結論から言えば、Filesearchは使ってはいけません。その代わりに、自分は＠ITのこちらのページhttp://www.atmarkit.co.jp/fwin2k/win2ktips/310filelist/filelist.htmlと、このページに掲載されているサンプルVBAプログラムを参考に、以下のように作り直しました。
Dim objFs As Object
Dim objFl As Object
Dim objFld As Object
Dim FoundFileCount As Integer ' 検索ファイル数
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFld = objFs.GetFolder(ThisWorkbook.Path & "..フォルダ名")
FoundFileCount = 0 ' 初期化
For Each objFl In objFld.Files
If (objFl.Type = "Microsoft Excel ワークシート") Then
FoundFileCount = FoundFileCount + 1
' フォルダ内のExcelを一つずつ開く
Set wb_OrderFile = Workbooks.Open(objFl.Path)
ActiveSheet.Copy before:=DummyWB.Sheets(FoundFileCount)
wb_OrderFile.Close
Label1.Caption = Int(FoundFileCount / objFld.Files.Count * 100)
DoEvents ' ラベル更新のため
End If
Next
If FoundFileCount = 0 Then
MsgBox "適切なファイルがフォルダ内に存在しません。", vbInformation, "検索結果"
OpeningMessage.Hide
Exit Sub
End If
フォームも使うプログラムなんで、ちょこちょこ不要な部分もありますが、要はWindows Scriptを使用するということです。FindFirstFile関数のようなAPIも使用しないし、コーディングが容易にできます。但し、古いPCでこのWindows Scriptが使用できるかどうかは定かではありませんが、少なくとも、Win2000とWinXPでは動作します☆
ご参考になれば幸いです。