0

データの入力に使用するいくつかの Excel ファイルがあります。ファイルの機能は同じで、当社の各サービス センターに 1 つずつあります。フォームには、データを別のシートのテーブル形式に変換するマクロを起動するボタンがあり、後で Access db にアップロードされます。

自分のコンピューターではすべてうまくいきました。新しい行の追加、既存の行の更新、および既存の役割の削除。ファイルをネットワーク ドライブに移動したときに問題が発生する早期バインドを使用していました。ファイルを遅延バインディングに変換することはできましたが、別の問題が発生しました。

ほとんどの場合、特に複数のユーザーが同時に作業を行おうとすると、Access へのアップロードが機能しません。最も一般的なエラー コードは、更新可能なクエリを使用していないか、このメソッドが後方スクロールをサポートしていないことです。実際のエラー コードを報告できなくて申し訳ありませんが、現時点では再現できません。

私の接続コードは次のとおりです。これは、さまざまな例のコピー ペースト コードを少し混ぜたものです。

接続およびその他の事前準備を開く

Sub excel2access()

Const adUseClient = 3  
Const adUseServer = 2
Const adLockOptimistic = 3
Const adOpenKeyset = 1
Const adOpenDynamic = 2

Dim oConn As Object
Dim cmd As Object
Dim rs As Object
Dim r As Long
Dim criteria As String
Dim Rng As Range

Set oConn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")

oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source= '" & Range("dbpath").Value & "\" & Range("dbfile").Value & "' ;"

Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "Select * from need_rows WHERE service_center = '" & Range("scenter_name").Value & "'", oConn

r = 2 ' the start row in the worksheet

Sheets("data").Select

この次のビットは、Excel シートのデータを調べて、そのサービス センターで見つかったレコードセットから一致を見つけようとします。一致が見つからない場合は新しいレコードが作成され、一致が見つかった場合は古いレコードが更新されます。

Do While Len(Range("A" & r).Formula) > 0
    With rs
        criteria = Range("D" & r).Value
        .Find "identifier='" & criteria & "'"
        If (.EOF = True) Or (.BOF = True) Then
            .AddNew ' create a new record
            .Fields("service_center") = Range("scenter_name").Value
            .Fields("product_id") = Range("A" & r).Value
            .Fields("quantity") = Range("B" & r).Value
            .Fields("use_date") = Range("C" & r).Value
            .Fields("identifier") = Range("D" & r).Value
            .Fields("file_type") = Range("file_type").Value
            .Fields("use_type") = Range("E" & r).Value
            .Fields("updated_at") = Now
            .Update             
        Else
            If .Fields("quantity") <> Range("B" & r).Value Then
                .Fields("quantity") = Range("B" & r).Value
                .Fields("updated_at") = Now
                .Update ' stores the new record
            End If                      
        End If
        .MoveFirst 
    End With
    r = r + 1 
Loop

rs.Close
Set rs = Nothing
Set oConn = Nothing

MsgBox "Confirmation message"
End Sub

編集: barrowc によるリンクに基づいて、カーソルの種類を adOpenStatic に変更しました。複数のユーザーが同時にデータをアップロードしようとしているテストを行ったところ、すべてが完全に機能しました。1 人のユーザーがファイルにとどまり、そこでデータを編集するのにかなりの時間を費やし、データを db にアップロードしようとすると、次のエラー メッセージが表示されるまで: https://dl.dropbox.com/u/3815482/vba_error.jpg

再び、出発点に戻ってきました。

また、一般的に私のコードに関するフィードバックも受け付けています。

Office2010を使用しています。

私はそれを間違っていますか？すべての助けに感謝します。

4

3 に答える 3

1

あなたの環境では、Jet の信頼性が十分ではないように思えます。私は頻繁に SQL Server / Access Data Projects を使用して、複数のスプレッドシートからの情報を 1 つのデータベース バックエンドに統合します。

于 2012-10-29T15:13:11.087 に答える
0

アクション クエリを使用することもできます。まず、次を使用して更新を試みます (現在の値をフォーマットする必要がある場合があります)。

dim count as long
oConn.Execute "UPDATE need_rows SET quantity = " & Range("B" & r).Value & ", updated_at = #" & Now & "# WHERE service_center = '" & Range("scenter_name").Value & "' AND identifier='" & Range("D" & r).Value & "' AND quantity <> " & Range("B" & r).Value", count

カウントがゼロの場合、行は更新されていないため、更新する行がないか、数量が変更されていません。どちらの方法でも INSERT を試みることができますが、後者の場合は失敗しますが、問題は発生しません。

if count = 0 then
    count = oConn.Execute "INSERT ...", count
    if count = 0 then
        ' quantity has not changed, so nothing to do
    else
        ' new record inserted
    end if
else
    ' record updated
end if
于 2015-09-11T15:48:17.637 に答える