VB6.0用掲示板の過去のログ(No.2)−VBレスキュー(花ちゃん)
[記事リスト]
[新規投稿]
[新着記事]
[ワード検索]
[管理用]
| 投稿日 | ： 2005/09/16(Fri) 22:13 |
| 投稿者 | ： NM |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Excelファイル操作時のエラー |
お世話になります。
ＶＢでエクセル操作中に出る下記のメッセージの原因を調査しております。
エクセル関係のエラーに関する注意書きを読んだ上で設計したつもりなのですが、
原因がよく解りません。
対策方法は、MicrosoftやいろんなURLを探した所、OLEの時間を設定する記述がありました。
まずは対策方法を講じる前にExcel操作時の手順として、何か間違っているでしょうか。
とても長い内容で恐縮ですが、実際の関数は以下のものです。
ご教授ください。よろしくお願い致します。
＜エラーメッセージ＞
「他のアプリケーションがサーバを使用しているため、この操作を完了できません。
操作を続けるには、「切り替え」ボタンを選択して、他のアプリケーションを
終了させてください。」
実際の処理：
Public Sub XLS_FILE_WRITE(strName As String, D_no As Integer)
'Excel Work
Dim WkbObj As Workbook
Dim objADOConnection As ADODB.Connection
Dim objADORecordset As ADODB.Recordset
Dim strSheetName(10) As String
Dim SheetCount As Integer
Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer, r As
Integer, h As Integer
Dim strSelect As String
Select Case D_no
Case 2:
strSheetName(0) = UCase("Data")
strSheetName(1) = UCase("Data_Str")
SheetCount = 2
Case 3:
strSheetName(0) = UCase("Data-DropSup")
SheetCount = 1
Case 4:
strSheetName(0) = UCase("Data-DropAdd")
SheetCount = 1
Case 5:
strSheetName(0) = UCase("InputData")
strSheetName(1) = UCase("Data_Str")
SheetCount = 2
Case Else:
End Select
On Error GoTo MYEND1
Set objADOConnection = New ADODB.Connection
objADOConnection.Provider = "Microsoft.Jet.OLEDB.4.0"
objADOConnection.Properties("Extended Properties") = "Excel 8.0"
Err.Number = 0
objADOConnection.Open strName
Set objADORecordset = New ADODB.Recordset
If Err.Number = 0 Then
For i = 0 To SheetCount - 1
objADORecordset.ActiveConnection = objADOConnection
objADORecordset.CursorType = adOpenForwardOnly
objADORecordset.LockType = adLockPessimistic
strSelect = "select * from [" + strSheetName(i) + "$]"
Err.Number = 0
objADORecordset.Open strSelect, , , , adCmdUnknown
If Err.Number = 0 Then
objADORecordset.MoveFirst
r = 0
Do Until objADORecordset.EOF
For j = 0 To objADORecordset.Fields.Count - 1
Select Case UCase(strSheetName(i))
Case UCase(strSheetName(i))
Select Case UCase(objADORecordset.Fields(j).Name)
Case UCase("Val"):
Select Case D_no
Case 0:
objADORecordset.Fields(j).Value = _
RecipeData(r).A06_Val
Case 2:
objADORecordset.Fields(j).Value = _
CHBData(r).A06_Val
Case 3:
objADORecordset.Fields(j).Value = _
LC_DropSup(r).A06_Val
Case 4:
objADORecordset.Fields(j).Value = _
LC_DropAdd(r).A06_Val
Case 5:
objADORecordset.Fields(j).Value = _
LCData(r).A06_Val
Case Else:
End Select
Case UCase("Str"):
Select Case D_no
Case 0:
objADORecordset.Fields(j).Value = _
RecipeData_str(r).A08_Str
Case 2:
objADORecordset.Fields(j).Value = _
CHBData_Str(r).A08_Str
Case 5:
objADORecordset.Fields(j).Value = _
LCData_Str(r).A08_Str
Case Else:
End Select
Case Else
End Select
End Select
Next
objADORecordset.Update
objADORecordset.MoveNext
r = r + 1
Loop
objADORecordset.Close
End If
Next
Set objADORecordset = Nothing
objADOConnection.Close
Set objADOConnection = Nothing
Debug.Print "WndData Save End:" + str(Timer)
'Excute Calculate
Debug.Print "Cal Start:" + str(Timer)
Set WkbObj = GetObject(strName)
For i = 0 To WkbObj.Worksheets.Count - 1
WkbObj.Worksheets(WkbObj.Worksheets.Item(i + 1).Name).Calculate
Next
WkbObj.Application.Windows(1).Activate
WkbObj.Save
WkbObj.Application.Quit
Set WkbObj = Nothing
Debug.Print "Cal End:" + str(Timer)
End If
Exit Sub
MYEND1:
On Error Resume Next
objADORecordset.Close
Set objADORecordset = Nothing
objADOConnection.Close
Set objADOConnection = Nothing
MyMSGBox "Excel Write Error" & Err.Description, vbOKOnly, "ERROR !&q
uot;
End Sub
- 関連一覧ツリー
（★ をクリックするとツリー全体を一括表示します）
- 返信フォーム
（この記事に返信する場合は下記フォームから投稿して下さい）