アプリ版:「スタンプのみでお礼する」機能のリリースについて

こんにちは。
いつもお世話になっております。

Excelがインストールされていない環境でExcelファイルの中身を参照するために
ADOを使用した処理を実装しています。
以下のようなコードで動作しましたが、一度処理を実行後に続けて処理を実行した場合に
ファイルアクセスのエラー(ConnectionのOpen時)が発生してしまいます。
(実行時エラー'2147418113 (8000ffff)'「致命的なエラーです。」)
EXEを終了し、再度処理を実行するとうまく動作します。
おそらくExcelファイルのインスタンスが解放できていないという類のエラーであると思いますが、原因が分かりません。
(EXE起動後の2回目の処理で必ず発生するわけではなく、3回目の場合があるのも謎です。)
何か分かりましたらご教示下さい。

---------------------------------------------------------------------------------
inputFileName = App.Path + "\test.xls"
outPutFileName = App.Path + "\test.csv"

On Error GoTo errorHdr

Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" + inputFileName + ";" + "Extended Properties=Excel 5.0;"
.Open
End With

strSQL = "SELECT * FROM [sheet1$]"

Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open strSQL, cn, adOpenDynamic, adLockReadOnly, adCmdText

On Error GoTo 0

x = FreeFile
Open outPutFileName For Output As #x
Do Until rs.EOF
buff = ""
For col = 1 To rs.Fields.Count
If col < rs.Fields.Count Then
buff = buff & rs.Fields(col - 1).Value & ","
Else
buff = buff & rs.Fields(col - 1).Value
End If
Next
If Len(buff) = rs.Fields.Count - 1 Then
Exit Do
End If
Print #x, buff
rs.MoveNext
Loop
Close #x

rs.Close
Set rs = Nothing

cn.Close
Set cn = Nothing

MsgBox "完了しました。", vbInformation

Exit Sub

errorHdr:
On Error GoTo 0

MsgBox "ファイルのオープンに失敗しました。", vbCritical

If rs Is Nothing = False Then
If rs.State = adStateOpen Then
rs.Close
End If
Set rs = Nothing
End If

If cn.State = adStateOpen Then
cn.Close
End If
Set cn = Nothing

End Sub
---------------------------------------------------------------------------------

<環境>
Windows 2000(SP4), VB6.0(S6)
※ExcelファイルはExcel 95で作成(2500行×15列程度)

A 回答 (1件)

>Set cn = New ADODB.Connection


>With cn
>.Provider = "Microsoft.Jet.OLEDB.4.0"
>.ConnectionString = "Data Source=" + inputFileName + ";" + "Extended Properties=Excel 5.0;"
>.Open
>End With
の後に以下を入れてみてください。

'終了まで待つ
Do While cn.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While cn.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
Loop

この回答への補足

>tomo316さん
回答ありがとうございます。

教えていただいたコードを挿入してみたところ、
「実行時エラー '3001'
引数が間違った型、または許容範囲外であるか、競合しています。」
が表示されました。

何か分かりましたらご教示下さい。

補足日時:2007/12/27 20:28
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!